1/* Build expressions with type checking for CHILL compiler. 2 Copyright (C) 1992, 93, 1994, 1998, 1999 Free Software Foundation, Inc. 3 4This file is part of GNU CC. 5 6GNU CC is free software; you can redistribute it and/or modify 7it under the terms of the GNU General Public License as published by 8the Free Software Foundation; either version 2, or (at your option) 9any later version. 10 11GNU CC is distributed in the hope that it will be useful, 12but WITHOUT ANY WARRANTY; without even the implied warranty of 13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14GNU General Public License for more details. 15 16You should have received a copy of the GNU General Public License 17along with GNU CC; see the file COPYING. If not, write to 18the Free Software Foundation, 59 Temple Place - Suite 330, 19Boston, MA 02111-1307, USA. */ 20 21 22/* This file is part of the CHILL front end. 23 It contains routines to build C expressions given their operands, 24 including computing the modes of the result, C-specific error checks, 25 and some optimization. 26 27 There are also routines to build RETURN_STMT nodes and CASE_STMT nodes, 28 and to process initializations in declarations (since they work 29 like a strange sort of assignment). */ 30 31#include "config.h" 32#include "system.h" 33#include "tree.h" 34#include "ch-tree.h" 35#include "flags.h" 36#include "rtl.h" 37#include "expr.h" 38#include "lex.h" 39#include "toplev.h" 40 41extern tree intQI_type_node; 42extern tree intHI_type_node; 43extern tree intSI_type_node; 44extern tree intDI_type_node; 45#if HOST_BITS_PER_WIDE_INT >= 64 46extern tree intTI_type_node; 47#endif 48 49extern tree unsigned_intQI_type_node; 50extern tree unsigned_intHI_type_node; 51extern tree unsigned_intSI_type_node; 52extern tree unsigned_intDI_type_node; 53#if HOST_BITS_PER_WIDE_INT >= 64 54extern tree unsigned_intTI_type_node; 55#endif 56 57/* forward declarations */ 58static int chill_l_equivalent PROTO((tree, tree, struct mode_chain*)); 59static tree extract_constant_from_buffer PROTO((tree, unsigned char *, int)); 60static int expand_constant_to_buffer PROTO((tree, unsigned char *, int)); 61 62/* 63 * This function checks an array access. 64 * It calls error (ERROR_MESSAGE) if the condition (index <= domain max value 65 * index >= domain min value) 66 * is not met at compile time, 67 * If a runtime test is required and permitted, 68 * check_expression is used to do so. 69 * the global RANGE_CHECKING flags controls the 70 * generation of runtime checking code. 71 */ 72tree 73valid_array_index_p (array, idx, error_message, is_varying_lhs) 74 tree array, idx; 75 char *error_message; 76 int is_varying_lhs; 77{ 78 tree cond, low_limit, high_cond, atype, domain; 79 tree orig_index = idx; 80 enum chill_tree_code condition; 81 82 if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK 83 || idx == NULL_TREE || TREE_CODE (idx) == ERROR_MARK) 84 return error_mark_node; 85 86 if (TREE_CODE (idx) == TYPE_DECL 87 || TREE_CODE_CLASS (TREE_CODE (idx)) == 't') 88 { 89 error ("array or string index is a mode (instead of a value)"); 90 return error_mark_node; 91 } 92 93 atype = TREE_TYPE (array); 94 95 if (chill_varying_type_p (atype)) 96 { 97 domain = TYPE_DOMAIN (CH_VARYING_ARRAY_TYPE (atype)); 98 high_cond = build_component_ref (array, var_length_id); 99 if (chill_varying_string_type_p (atype)) 100 { 101 if (is_varying_lhs) 102 condition = GT_EXPR; 103 else 104 condition = GE_EXPR; 105 } 106 else 107 condition = GT_EXPR; 108 } 109 else 110 { 111 domain = TYPE_DOMAIN (atype); 112 high_cond = TYPE_MAX_VALUE (domain); 113 condition = GT_EXPR; 114 } 115 116 if (CH_STRING_TYPE_P (atype)) 117 { 118 if (! CH_SIMILAR (TREE_TYPE (orig_index), integer_type_node)) 119 { 120 error ("index is not an integer expression"); 121 return error_mark_node; 122 } 123 } 124 else 125 { 126 if (! CH_COMPATIBLE (orig_index, domain)) 127 { 128 error ("index not compatible with index mode"); 129 return error_mark_node; 130 } 131 } 132 133 /* Convert BOOLS(1) to BOOL and CHARS(1) to CHAR. */ 134 if (flag_old_strings) 135 { 136 idx = convert_to_discrete (idx); 137 if (idx == NULL) /* should never happen */ 138 error ("index is not discrete"); 139 } 140 141 /* we know we'll refer to this value twice */ 142 if (range_checking) 143 idx = save_expr (idx); 144 145 low_limit = TYPE_MIN_VALUE (domain); 146 high_cond = build_compare_discrete_expr (condition, idx, high_cond); 147 148 /* an invalid index expression meets this condition */ 149 cond = fold (build (TRUTH_ORIF_EXPR, boolean_type_node, 150 build_compare_discrete_expr (LT_EXPR, idx, low_limit), 151 high_cond)); 152 153 /* strip a redundant NOP_EXPR */ 154 if (TREE_CODE (cond) == NOP_EXPR 155 && TREE_TYPE (cond) == boolean_type_node 156 && TREE_CODE (TREE_OPERAND (cond, 0)) == INTEGER_CST) 157 cond = TREE_OPERAND (cond, 0); 158 159 idx = convert (CH_STRING_TYPE_P (atype) ? integer_type_node : domain, 160 idx); 161 162 if (TREE_CODE (cond) == INTEGER_CST) 163 { 164 if (tree_int_cst_equal (cond, boolean_false_node)) 165 return idx; /* condition met at compile time */ 166 error (error_message); /* condition failed at compile time */ 167 return error_mark_node; 168 } 169 else if (range_checking) 170 { 171 /* FIXME: often, several of these conditions will 172 be generated for the same source file and line number. 173 A great optimization would be to share the 174 cause_exception function call among them rather 175 than generating a cause_exception call for each. */ 176 return check_expression (idx, cond, 177 ridpointers[(int) RID_RANGEFAIL]); 178 } 179 else 180 return idx; /* don't know at compile time */ 181} 182 183/* 184 * Extract a slice from an array, which could look like a 185 * SET_TYPE if it's a bitstring. The array could also be VARYING 186 * if the element type is CHAR. The min_value and length values 187 * must have already been checked with valid_array_index_p. No 188 * checking is done here. 189 */ 190tree 191build_chill_slice (array, min_value, length) 192 tree array, min_value, length; 193{ 194 tree result; 195 tree array_type = TREE_TYPE (array); 196 197 if (!CH_REFERABLE (array) && TREE_CODE (array) != SAVE_EXPR 198 && (TREE_CODE (array) != COMPONENT_REF 199 || TREE_CODE (TREE_OPERAND (array, 0)) != SAVE_EXPR)) 200 { 201 if (!TREE_CONSTANT (array)) 202 warning ("possible internal error - slice argument is neither referable nor constant"); 203 else 204 { 205 /* Force to storage. 206 NOTE: This could mean multiple identical copies of 207 the same constant. FIXME. */ 208 tree mydecl = decl_temp1 (get_unique_identifier("SLICEE"), 209 array_type, 1, array, 0, 0); 210 TREE_READONLY (mydecl) = 1; 211 /* mark_addressable (mydecl); FIXME: necessary? */ 212 array = mydecl; 213 } 214 } 215 216 /* 217 The code-generation which uses a slice tree needs not only to 218 know the dynamic upper and lower limits of that slice, but the 219 original static allocation, to use to build temps where one or both 220 of the dynamic limits must be calculated at runtime.. We pass the 221 dynamic size by building a new array_type whose limits are the 222 min_value and min_value + length values passed to us. 223 224 The static allocation info is passed by using the parent array's 225 limits to compute a temp_size, which is passed in the lang_specific 226 field of the slice_type. 227 */ 228 229 if (TREE_CODE (array_type) == ARRAY_TYPE) 230 { 231 tree domain_type = TYPE_DOMAIN (array_type); 232 tree domain_min = TYPE_MIN_VALUE (domain_type); 233 tree domain_max = fold (build (PLUS_EXPR, domain_type, 234 domain_min, 235 size_binop (MINUS_EXPR, 236 length, integer_one_node))); 237 tree index_type = build_chill_range_type (TYPE_DOMAIN (array_type), 238 domain_min, 239 domain_max); 240 241 tree element_type = TREE_TYPE (array_type); 242 tree slice_type = build_simple_array_type (element_type, index_type, NULL_TREE); 243 tree slice_pointer_type; 244 tree max_size; 245 246 if (CH_CHARS_TYPE_P (array_type)) 247 MARK_AS_STRING_TYPE (slice_type); 248 else 249 TYPE_PACKED (slice_type) = TYPE_PACKED (array_type); 250 251 SET_CH_NOVELTY (slice_type, CH_NOVELTY (array_type)); 252 253 if (TREE_CONSTANT (array) && TREE_CODE (min_value) == INTEGER_CST 254 && TREE_CODE (length) == INTEGER_CST) 255 { 256 int type_size = int_size_in_bytes (array_type); 257 unsigned char *buffer = (unsigned char*) alloca (type_size); 258 int delta = int_size_in_bytes (element_type) 259 * (TREE_INT_CST_LOW (min_value) - TREE_INT_CST_LOW (domain_min)); 260 bzero (buffer, type_size); 261 if (expand_constant_to_buffer (array, buffer, type_size)) 262 { 263 result = extract_constant_from_buffer (slice_type, 264 buffer + delta, 265 type_size - delta); 266 if (result) 267 return result; 268 } 269 } 270 271 /* Kludge used by case CONCAT_EXPR in chill_expand_expr. 272 Set TYPE_ARRAY_MAX_SIZE to a constant upper bound on the 273 bytes needed. */ 274 max_size = size_in_bytes (slice_type); 275 if (TREE_CODE (max_size) != INTEGER_CST) 276 { 277 max_size = TYPE_ARRAY_MAX_SIZE (array_type); 278 if (max_size == NULL_TREE) 279 max_size = size_in_bytes (array_type); 280 } 281 TYPE_ARRAY_MAX_SIZE (slice_type) = max_size; 282 283 mark_addressable (array); 284 /* Contruct a SLICE_EXPR to represent a slice of a packed array of bits. */ 285 if (TYPE_PACKED (array_type)) 286 { 287 if (pass == 2 && TREE_CODE (length) != INTEGER_CST) 288 { 289 sorry ("bit array slice with non-constant length"); 290 return error_mark_node; 291 } 292 if (domain_min && ! integer_zerop (domain_min)) 293 min_value = size_binop (MINUS_EXPR, min_value, 294 convert (sizetype, domain_min)); 295 result = build (SLICE_EXPR, slice_type, array, min_value, length); 296 TREE_READONLY (result) 297 = TREE_READONLY (array) | TYPE_READONLY (TREE_TYPE (array_type)); 298 return result; 299 } 300 301 slice_pointer_type = build_chill_pointer_type (slice_type); 302 if (TREE_CODE (min_value) == INTEGER_CST 303 && domain_min && TREE_CODE (domain_min) == INTEGER_CST 304 && compare_int_csts (EQ_EXPR, min_value, domain_min)) 305 result = fold (build1 (ADDR_EXPR, slice_pointer_type, array)); 306 else 307 { 308 min_value = convert (sizetype, min_value); 309 if (domain_min && ! integer_zerop (domain_min)) 310 min_value = size_binop (MINUS_EXPR, min_value, 311 convert (sizetype, domain_min)); 312 min_value = size_binop (MULT_EXPR, min_value, 313 size_in_bytes (element_type)); 314 result = fold (build (PLUS_EXPR, slice_pointer_type, 315 build1 (ADDR_EXPR, slice_pointer_type, 316 array), 317 convert (slice_pointer_type, min_value))); 318 } 319 /* Return the final array value. */ 320 result = fold (build1 (INDIRECT_REF, slice_type, result)); 321 TREE_READONLY (result) 322 = TREE_READONLY (array) | TYPE_READONLY (element_type); 323 return result; 324 } 325 else if (TREE_CODE (array_type) == SET_TYPE) /* actually a bitstring */ 326 { 327 if (pass == 2 && TREE_CODE (length) != INTEGER_CST) 328 { 329 sorry ("bitstring slice with non-constant length"); 330 return error_mark_node; 331 } 332 result = build (SLICE_EXPR, build_bitstring_type (length), 333 array, min_value, length); 334 TREE_READONLY (result) 335 = TREE_READONLY (array) | TYPE_READONLY (TREE_TYPE (array_type)); 336 return result; 337 } 338 else if (chill_varying_type_p (array_type)) 339 return build_chill_slice (varying_to_slice (array), min_value, length); 340 else 341 { 342 error ("slice operation on non-array, non-bitstring value not supported"); 343 return error_mark_node; 344 } 345} 346 347static tree 348build_empty_string (type) 349 tree type; 350{ 351 int orig_pass = pass; 352 tree range, result; 353 354 range = build_chill_range_type (type, integer_zero_node, 355 integer_minus_one_node); 356 result = build_chill_array_type (type, 357 tree_cons (NULL_TREE, range, NULL_TREE), 0, NULL_TREE); 358 pass = 2; 359 range = build_chill_range_type (type, integer_zero_node, 360 integer_minus_one_node); 361 result = build_chill_array_type (type, 362 tree_cons (NULL_TREE, range, NULL_TREE), 0, NULL_TREE); 363 pass = orig_pass; 364 365 return decl_temp1 (get_unique_identifier ("EMPTY_STRING"), 366 result, 0, NULL_TREE, 0, 0); 367} 368 369/* We build the runtime range-checking as a separate list 370 * rather than making a compound_expr with min_value 371 * (for example), to control when that comparison gets 372 * generated. We cannot allow it in a TYPE_MAX_VALUE or 373 * TYPE_MIN_VALUE expression, for instance, because that code 374 * will get generated when the slice is laid out, which would 375 * put it outside the scope of an exception handler for the 376 * statement we're generating. I.e. we would be generating 377 * cause_exception calls which might execute before the 378 * necessary ch_link_handler call. 379 */ 380tree 381build_chill_slice_with_range (array, min_value, max_value) 382 tree array, min_value, max_value; 383{ 384 if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK 385 || min_value == NULL_TREE || TREE_CODE(min_value) == ERROR_MARK 386 || max_value == NULL_TREE || TREE_CODE(max_value) == ERROR_MARK) 387 return error_mark_node; 388 389 if (TREE_TYPE (array) == NULL_TREE 390 || (TREE_CODE (TREE_TYPE (array)) != ARRAY_TYPE 391 && TREE_CODE (TREE_TYPE (array)) != SET_TYPE 392 && !chill_varying_type_p (TREE_TYPE (array)))) 393 { 394 error ("can only take slice of array or string"); 395 return error_mark_node; 396 } 397 398 array = save_if_needed (array); 399 400 /* FIXME: test here for max_value >= min_value, except 401 for max_value == -1, min_value == 0 (empty string) */ 402 min_value = valid_array_index_p (array, min_value, 403 "slice lower limit out-of-range", 0); 404 if (TREE_CODE (min_value) == ERROR_MARK) 405 return min_value; 406 407 /* FIXME: suppress this test if max_value is the LENGTH of a 408 varying array, which has presumably already been checked. */ 409 max_value = valid_array_index_p (array, max_value, 410 "slice upper limit out-of-range", 0); 411 if (TREE_CODE (max_value) == ERROR_MARK) 412 return error_mark_node; 413 414 if (TREE_CODE (min_value) == INTEGER_CST 415 && TREE_CODE (max_value) == INTEGER_CST 416 && tree_int_cst_lt (max_value, min_value)) 417 return build_empty_string (TREE_TYPE (TREE_TYPE (array))); 418 419 return build_chill_slice (array, min_value, 420 save_expr (size_binop (PLUS_EXPR, 421 size_binop (MINUS_EXPR, max_value, min_value), 422 integer_one_node))); 423} 424 425 426tree 427build_chill_slice_with_length (array, min_value, length) 428 tree array, min_value, length; 429{ 430 tree max_index; 431 tree cond, high_cond, atype; 432 433 if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK 434 || min_value == NULL_TREE || TREE_CODE(min_value) == ERROR_MARK 435 || length == NULL_TREE || TREE_CODE(length) == ERROR_MARK) 436 return error_mark_node; 437 438 if (TREE_TYPE (array) == NULL_TREE 439 || (TREE_CODE (TREE_TYPE (array)) != ARRAY_TYPE 440 && TREE_CODE (TREE_TYPE (array)) != SET_TYPE 441 && !chill_varying_type_p (TREE_TYPE (array)))) 442 { 443 error ("can only take slice of array or string"); 444 return error_mark_node; 445 } 446 447 if (TREE_CONSTANT (length) 448 && tree_int_cst_lt (length, integer_zero_node)) 449 return build_empty_string (TREE_TYPE (TREE_TYPE (array))); 450 451 array = save_if_needed (array); 452 min_value = save_expr (min_value); 453 length = save_expr (length); 454 455 if (! CH_SIMILAR (TREE_TYPE (length), integer_type_node)) 456 { 457 error ("slice length is not an integer"); 458 length = integer_one_node; 459 } 460 461 max_index = size_binop (MINUS_EXPR, 462 size_binop (PLUS_EXPR, length, min_value), 463 integer_one_node); 464 max_index = convert_to_class (chill_expr_class (min_value), max_index); 465 466 min_value = valid_array_index_p (array, min_value, 467 "slice start index out-of-range", 0); 468 if (TREE_CODE (min_value) == ERROR_MARK) 469 return error_mark_node; 470 471 atype = TREE_TYPE (array); 472 473 if (chill_varying_type_p (atype)) 474 high_cond = build_component_ref (array, var_length_id); 475 else 476 high_cond = TYPE_MAX_VALUE (TYPE_DOMAIN (atype)); 477 478 /* an invalid index expression meets this condition */ 479 cond = fold (build (TRUTH_ORIF_EXPR, boolean_type_node, 480 build_compare_discrete_expr (LT_EXPR, 481 length, integer_zero_node), 482 build_compare_discrete_expr (GT_EXPR, 483 max_index, high_cond))); 484 485 if (TREE_CODE (cond) == INTEGER_CST) 486 { 487 if (! tree_int_cst_equal (cond, boolean_false_node)) 488 { 489 error ("slice length out-of-range"); 490 return error_mark_node; 491 } 492 493 } 494 else if (range_checking) 495 { 496 min_value = check_expression (min_value, cond, 497 ridpointers[(int) RID_RANGEFAIL]); 498 } 499 500 return build_chill_slice (array, min_value, length); 501} 502 503tree 504build_chill_array_ref (array, indexlist) 505 tree array, indexlist; 506{ 507 tree idx; 508 509 if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK) 510 return error_mark_node; 511 if (indexlist == NULL_TREE || TREE_CODE (indexlist) == ERROR_MARK) 512 return error_mark_node; 513 514 idx = TREE_VALUE (indexlist); /* handle first index */ 515 516 idx = valid_array_index_p (array, idx, 517 "array index out-of-range", 0); 518 if (TREE_CODE (idx) == ERROR_MARK) 519 return error_mark_node; 520 521 array = build_chill_array_ref_1 (array, idx); 522 523 if (array && TREE_CODE (array) != ERROR_MARK 524 && TREE_CHAIN (indexlist)) 525 { 526 /* Z.200 (1988) section 4.2.8 says that: 527 <array> '(' <expression {',' <expression> }* ')' 528 is derived syntax (i.e. syntactic sugar) for: 529 <array> '(' <expression ')' { '(' <expression> ')' }* 530 The intent is clear if <array> has mode: ARRAY (...) ARRAY (...) XXX. 531 But what if <array> has mode: ARRAY (...) CHARS (N) 532 or: ARRAY (...) BOOLS (N). 533 Z.200 doesn't explicitly prohibit it, but the intent is unclear. 534 We'll allow it, since it seems reasonable and useful. 535 However, we won't allow it if <array> is: 536 ARRAY (...) PROC (...). 537 (The latter would make sense if we allowed general 538 Currying, which Chill doesn't.) */ 539 if (TREE_CODE (TREE_TYPE (array)) == ARRAY_TYPE 540 || chill_varying_type_p (TREE_TYPE (array)) 541 || CH_BOOLS_TYPE_P (TREE_TYPE (array))) 542 array = build_generalized_call (array, TREE_CHAIN (indexlist)); 543 else 544 error ("too many index expressions"); 545 } 546 return array; 547} 548 549/* 550 * Don't error check the index in here. It's supposed to be 551 * checked by the caller. 552 */ 553tree 554build_chill_array_ref_1 (array, idx) 555 tree array, idx; 556{ 557 tree type; 558 tree domain; 559 tree rval; 560 561 if (array == NULL_TREE || TREE_CODE (array) == ERROR_MARK 562 || idx == NULL_TREE || TREE_CODE (idx) == ERROR_MARK) 563 return error_mark_node; 564 565 if (chill_varying_type_p (TREE_TYPE (array))) 566 array = varying_to_slice (array); 567 568 domain = TYPE_DOMAIN (TREE_TYPE (array)); 569 570#if 0 571 if (! integer_zerop (TYPE_MIN_VALUE (domain))) 572 { 573 /* The C part of the compiler doesn't understand how to do 574 arithmetic with dissimilar enum types. So we check compatability 575 here, and perform the math in INTEGER_TYPE. */ 576 if (TREE_CODE (TREE_TYPE (idx)) == ENUMERAL_TYPE 577 && chill_comptypes (TREE_TYPE (idx), domain, 0)) 578 idx = convert (TREE_TYPE (TYPE_MIN_VALUE (domain)), idx); 579 idx = build_binary_op (MINUS_EXPR, idx, TYPE_MIN_VALUE (domain), 0); 580 } 581#endif 582 583 if (CH_STRING_TYPE_P (TREE_TYPE (array))) 584 { 585 /* Could be bitstring or char string. */ 586 if (TREE_TYPE (TREE_TYPE (array)) == boolean_type_node) 587 { 588 rval = build (SET_IN_EXPR, boolean_type_node, idx, array); 589 TREE_READONLY (rval) = TREE_READONLY (array); 590 return rval; 591 } 592 } 593 594 if (!discrete_type_p (TREE_TYPE (idx))) 595 { 596 error ("array index is not discrete"); 597 return error_mark_node; 598 } 599 600 /* An array that is indexed by a non-constant 601 cannot be stored in a register; we must be able to do 602 address arithmetic on its address. 603 Likewise an array of elements of variable size. */ 604 if (TREE_CODE (idx) != INTEGER_CST 605 || (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array))) != 0 606 && TREE_CODE (TYPE_SIZE (TREE_TYPE (TREE_TYPE (array)))) != INTEGER_CST)) 607 { 608 if (mark_addressable (array) == 0) 609 return error_mark_node; 610 } 611 612 type = TREE_TYPE (TREE_TYPE (array)); 613 614 /* Do constant folding */ 615 if (TREE_CODE (idx) == INTEGER_CST && TREE_CONSTANT (array)) 616 { 617 struct ch_class class; 618 class.kind = CH_VALUE_CLASS; 619 class.mode = type; 620 621 if (TREE_CODE (array) == CONSTRUCTOR) 622 { 623 tree list = CONSTRUCTOR_ELTS (array); 624 for ( ; list != NULL_TREE; list = TREE_CHAIN (list)) 625 { 626 if (tree_int_cst_equal (TREE_PURPOSE (list), idx)) 627 return convert_to_class (class, TREE_VALUE (list)); 628 } 629 } 630 else if (TREE_CODE (array) == STRING_CST 631 && CH_CHARS_TYPE_P (TREE_TYPE (array))) 632 { 633 HOST_WIDE_INT i = TREE_INT_CST_LOW (idx); 634 if (i >= 0 && i < TREE_STRING_LENGTH (array)) 635 { 636 char ch = TREE_STRING_POINTER (array) [i]; 637 return convert_to_class (class, 638 build_int_2 ((unsigned char)ch, 0)); 639 } 640 } 641 } 642 643 if (TYPE_PACKED (TREE_TYPE (array))) 644 rval = build (PACKED_ARRAY_REF, type, array, idx); 645 else 646 rval = build (ARRAY_REF, type, array, idx); 647 648 /* Array ref is const/volatile if the array elements are 649 or if the array is. */ 650 TREE_READONLY (rval) = TREE_READONLY (array) | TYPE_READONLY (type); 651 TREE_SIDE_EFFECTS (rval) 652 |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array))) 653 | TREE_SIDE_EFFECTS (array)); 654 TREE_THIS_VOLATILE (rval) 655 |= (TYPE_VOLATILE (TREE_TYPE (TREE_TYPE (array))) 656 /* This was added by rms on 16 Nov 91. 657 It fixes vol struct foo *a; a->elts[1] 658 in an inline function. 659 Hope it doesn't break something else. */ 660 | TREE_THIS_VOLATILE (array)); 661 return fold (rval); 662} 663 664tree 665build_chill_bitref (bitstring, indexlist) 666 tree bitstring, indexlist; 667{ 668 if (TREE_CODE (bitstring) == ERROR_MARK) 669 return bitstring; 670 if (TREE_CODE (indexlist) == ERROR_MARK) 671 return indexlist; 672 673 if (TREE_CHAIN (indexlist) != NULL_TREE) 674 { 675 error ("invalid compound index for bitstring mode"); 676 return error_mark_node; 677 } 678 679 if (TREE_CODE (indexlist) == TREE_LIST) 680 { 681 tree result = build (SET_IN_EXPR, boolean_type_node, 682 TREE_VALUE (indexlist), bitstring); 683 TREE_READONLY (result) = TREE_READONLY (bitstring); 684 return result; 685 } 686 else abort (); 687} 688 689 690int 691discrete_type_p (type) 692 tree type; 693{ 694 return INTEGRAL_TYPE_P (type); 695} 696 697/* Checks that EXP has discrete type, or can be converted to discrete. 698 Otherwise, returns NULL_TREE. 699 Normally returns the (possibly-converted) EXP. */ 700 701tree 702convert_to_discrete (exp) 703 tree exp; 704{ 705 if (! discrete_type_p (TREE_TYPE (exp))) 706 { 707 if (flag_old_strings) 708 { 709 if (CH_CHARS_ONE_P (TREE_TYPE (exp))) 710 return convert (char_type_node, exp); 711 if (CH_BOOLS_ONE_P (TREE_TYPE (exp))) 712 return convert (boolean_type_node, exp); 713 } 714 return NULL_TREE; 715 } 716 return exp; 717} 718 719/* Write into BUFFER the target-machine representation of VALUE. 720 Returns 1 on success, or 0 on failure. (Either the VALUE was 721 not constant, or we don't know how to do the conversion.) */ 722 723static int 724expand_constant_to_buffer (value, buffer, buf_size) 725 tree value; 726 unsigned char *buffer; 727 int buf_size; 728{ 729 tree type = TREE_TYPE (value); 730 int size = int_size_in_bytes (type); 731 int i; 732 if (size < 0 || size > buf_size) 733 return 0; 734 switch (TREE_CODE (value)) 735 { 736 case INTEGER_CST: 737 { 738 HOST_WIDE_INT lo = TREE_INT_CST_LOW (value); 739 HOST_WIDE_INT hi = TREE_INT_CST_HIGH (value); 740 for (i = 0; i < size; i++) 741 { 742 /* Doesn't work if host and target BITS_PER_UNIT differ. */ 743 unsigned char byte = lo & ((1 << BITS_PER_UNIT) - 1); 744 if (BYTES_BIG_ENDIAN) 745 buffer[size - i - 1] = byte; 746 else 747 buffer[i] = byte; 748 rshift_double (lo, hi, BITS_PER_UNIT, BITS_PER_UNIT * size, 749 &lo, &hi, 0); 750 } 751 } 752 break; 753 case STRING_CST: 754 { 755 size = TREE_STRING_LENGTH (value); 756 if (size > buf_size) 757 return 0; 758 bcopy (TREE_STRING_POINTER (value), buffer, size); 759 break; 760 } 761 case CONSTRUCTOR: 762 if (TREE_CODE (type) == ARRAY_TYPE) 763 { 764 tree element_type = TREE_TYPE (type); 765 int element_size = int_size_in_bytes (element_type); 766 tree list = CONSTRUCTOR_ELTS (value); 767 HOST_WIDE_INT next_index; 768 HOST_WIDE_INT min_index = 0; 769 if (element_size < 0) 770 return 0; 771 772 if (TYPE_DOMAIN (type) != 0) 773 { 774 tree min_val = TYPE_MIN_VALUE (TYPE_DOMAIN (type)); 775 if (min_val) 776 { 777 if (TREE_CODE (min_val) != INTEGER_CST) 778 return 0; 779 else 780 min_index = TREE_INT_CST_LOW (min_val); 781 } 782 } 783 784 next_index = min_index; 785 786 for (; list != NULL_TREE; list = TREE_CHAIN (list)) 787 { 788 HOST_WIDE_INT offset; 789 HOST_WIDE_INT last_index; 790 tree purpose = TREE_PURPOSE (list); 791 if (purpose) 792 { 793 if (TREE_CODE (purpose) == INTEGER_CST) 794 last_index = next_index = TREE_INT_CST_LOW (purpose); 795 else if (TREE_CODE (purpose) == RANGE_EXPR) 796 { 797 next_index = TREE_INT_CST_LOW (TREE_OPERAND(purpose, 0)); 798 last_index = TREE_INT_CST_LOW (TREE_OPERAND(purpose, 1)); 799 } 800 else 801 return 0; 802 } 803 else 804 last_index = next_index; 805 for ( ; next_index <= last_index; next_index++) 806 { 807 offset = (next_index - min_index) * element_size; 808 if (!expand_constant_to_buffer (TREE_VALUE (list), 809 buffer + offset, 810 buf_size - offset)) 811 return 0; 812 } 813 } 814 break; 815 } 816 else if (TREE_CODE (type) == RECORD_TYPE) 817 { 818 tree list = CONSTRUCTOR_ELTS (value); 819 for (; list != NULL_TREE; list = TREE_CHAIN (list)) 820 { 821 tree field = TREE_PURPOSE (list); 822 HOST_WIDE_INT offset; 823 if (field == NULL_TREE || TREE_CODE (field) != FIELD_DECL) 824 return 0; 825 if (DECL_BIT_FIELD (field)) 826 return 0; 827 offset = TREE_INT_CST_LOW (DECL_FIELD_BITPOS (field)) 828 / BITS_PER_UNIT; 829 if (!expand_constant_to_buffer (TREE_VALUE (list), 830 buffer + offset, 831 buf_size - offset)) 832 return 0; 833 } 834 break; 835 } 836 else if (TREE_CODE (type) == SET_TYPE) 837 { 838 if (get_set_constructor_bytes (value, buffer, buf_size) 839 != NULL_TREE) 840 return 0; 841 } 842 break; 843 default: 844 return 0; 845 } 846 return 1; 847} 848 849/* Given that BUFFER contains a target-machine representation of 850 a value of type TYPE, return that value as a tree. 851 Returns NULL_TREE on failure. (E.g. the TYPE might be variable size, 852 or perhaps we don't know how to do the conversion.) */ 853 854static tree 855extract_constant_from_buffer (type, buffer, buf_size) 856 tree type; 857 unsigned char *buffer; 858 int buf_size; 859{ 860 tree value; 861 int size = int_size_in_bytes (type); 862 int i; 863 if (size < 0 || size > buf_size) 864 return 0; 865 switch (TREE_CODE (type)) 866 { 867 case INTEGER_TYPE: 868 case CHAR_TYPE: 869 case BOOLEAN_TYPE: 870 case ENUMERAL_TYPE: 871 case POINTER_TYPE: 872 { 873 HOST_WIDE_INT lo = 0, hi = 0; 874 /* Accumulate (into (lo,hi) the bytes (from buffer). */ 875 for (i = size; --i >= 0; ) 876 { 877 unsigned char byte; 878 /* Get next byte (in big-endian order). */ 879 if (BYTES_BIG_ENDIAN) 880 byte = buffer[size - i - 1]; 881 else 882 byte = buffer[i]; 883 lshift_double (lo, hi, BITS_PER_UNIT, TYPE_PRECISION (type), 884 &lo, &hi, 0); 885 add_double (lo, hi, byte, 0, &lo, &hi); 886 } 887 value = build_int_2 (lo, hi); 888 TREE_TYPE (value) = type; 889 return value; 890 } 891 case ARRAY_TYPE: 892 { 893 tree element_type = TREE_TYPE (type); 894 int element_size = int_size_in_bytes (element_type); 895 tree list = NULL_TREE; 896 HOST_WIDE_INT min_index = 0, max_index, cur_index; 897 if (element_size == 1 && CH_CHARS_TYPE_P (type)) 898 { 899 value = build_string (size, buffer); 900 CH_DERIVED_FLAG (value) = 1; 901 TREE_TYPE (value) = type; 902 return value; 903 } 904 if (TYPE_DOMAIN (type) == 0) 905 return 0; 906 value = TYPE_MIN_VALUE (TYPE_DOMAIN (type)); 907 if (value) 908 { 909 if (TREE_CODE (value) != INTEGER_CST) 910 return 0; 911 else 912 min_index = TREE_INT_CST_LOW (value); 913 } 914 value = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); 915 if (value == NULL_TREE || TREE_CODE (value) != INTEGER_CST) 916 return 0; 917 else 918 max_index = TREE_INT_CST_LOW (value); 919 for (cur_index = max_index; cur_index >= min_index; cur_index--) 920 { 921 HOST_WIDE_INT offset = (cur_index - min_index) * element_size; 922 value = extract_constant_from_buffer (element_type, 923 buffer + offset, 924 buf_size - offset); 925 if (value == NULL_TREE) 926 return NULL_TREE; 927 list = tree_cons (build_int_2 (cur_index, 0), value, list); 928 } 929 value = build (CONSTRUCTOR, type, NULL_TREE, list); 930 TREE_CONSTANT (value) = 1; 931 TREE_STATIC (value) = 1; 932 return value; 933 } 934 case RECORD_TYPE: 935 { 936 tree list = NULL_TREE; 937 tree field = TYPE_FIELDS (type); 938 for (; field != NULL_TREE; field = TREE_CHAIN (field)) 939 { 940 HOST_WIDE_INT offset 941 = TREE_INT_CST_LOW (DECL_FIELD_BITPOS (field)) / BITS_PER_UNIT; 942 if (DECL_BIT_FIELD (field)) 943 return 0; 944 value = extract_constant_from_buffer (TREE_TYPE (field), 945 buffer + offset, 946 buf_size - offset); 947 if (value == NULL_TREE) 948 return NULL_TREE; 949 list = tree_cons (field, value, list); 950 } 951 value = build (CONSTRUCTOR, type, NULL_TREE, nreverse (list)); 952 TREE_CONSTANT (value) = 1; 953 TREE_STATIC (value) = 1; 954 return value; 955 } 956 957 case UNION_TYPE: 958 { 959 tree longest_variant = NULL_TREE; 960 int longest_size = 0; 961 tree field = TYPE_FIELDS (type); 962 963 /* This is a kludge. We assume that converting the data to te 964 longest variant will provide valid data for the "correct" 965 variant. This is usually the case, but is not guaranteed. 966 For example, the longest variant may include holes. 967 Also incorrect interpreting the given value as the longest 968 variant may confuse the compiler if that should happen 969 to yield invalid values. ??? */ 970 971 for (; field != NULL_TREE; field = TREE_CHAIN (field)) 972 { 973 int size = TREE_INT_CST_LOW (size_in_bytes (TREE_TYPE (field))); 974 975 if (size > longest_size) 976 { 977 longest_size = size; 978 longest_variant = field; 979 } 980 } 981 if (longest_variant == NULL_TREE) 982 return NULL_TREE; 983 return extract_constant_from_buffer (TREE_TYPE (longest_variant), buffer, buf_size); 984 } 985 986 case SET_TYPE: 987 { 988 tree list = NULL_TREE; 989 int i; 990 HOST_WIDE_INT min_index, max_index; 991 if (TYPE_DOMAIN (type) == 0) 992 return 0; 993 value = TYPE_MIN_VALUE (TYPE_DOMAIN (type)); 994 if (value == NULL_TREE) 995 min_index = 0; 996 else if (TREE_CODE (value) != INTEGER_CST) 997 return 0; 998 else 999 min_index = TREE_INT_CST_LOW (value); 1000 value = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); 1001 if (value == NULL_TREE) 1002 max_index = 0; 1003 else if (TREE_CODE (value) != INTEGER_CST) 1004 return 0; 1005 else 1006 max_index = TREE_INT_CST_LOW (value); 1007 for (i = max_index + 1 - min_index; --i >= 0; ) 1008 { 1009 unsigned char byte = (unsigned char)buffer[i / BITS_PER_UNIT]; 1010 unsigned bit_pos = (unsigned)i % (unsigned)BITS_PER_UNIT; 1011 if (BYTES_BIG_ENDIAN 1012 ? (byte & (1 << (BITS_PER_UNIT - 1 - bit_pos))) 1013 : (byte & (1 << bit_pos))) 1014 list = tree_cons (NULL_TREE, 1015 build_int_2 (i + min_index, 0), list); 1016 } 1017 value = build (CONSTRUCTOR, type, NULL_TREE, list); 1018 TREE_CONSTANT (value) = 1; 1019 TREE_STATIC (value) = 1; 1020 return value; 1021 } 1022 1023 default: 1024 return NULL_TREE; 1025 } 1026} 1027 1028tree 1029build_chill_cast (type, expr) 1030 tree type, expr; 1031{ 1032 tree expr_type; 1033 int expr_type_size; 1034 int type_size; 1035 int type_is_discrete; 1036 int expr_type_is_discrete; 1037 1038 if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK) 1039 return error_mark_node; 1040 if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK) 1041 return error_mark_node; 1042 1043 /* if expression was untyped because of its context (an 1044 if_expr or case_expr in a tuple, perhaps) just apply 1045 the type */ 1046 expr_type = TREE_TYPE (expr); 1047 if (expr_type == NULL_TREE 1048 || TREE_CODE (expr_type) == ERROR_MARK) 1049 return convert (type, expr); 1050 1051 if (expr_type == type) 1052 return expr; 1053 1054 expr_type_size = int_size_in_bytes (expr_type); 1055 type_size = int_size_in_bytes (type); 1056 1057 if (expr_type_size == -1) 1058 { 1059 error ("conversions from variable_size value"); 1060 return error_mark_node; 1061 } 1062 if (type_size == -1) 1063 { 1064 error ("conversions to variable_size mode"); 1065 return error_mark_node; 1066 } 1067 1068 /* FIXME: process REAL ==> INT && INT ==> REAL && REAL ==> REAL. I hope this is correct. */ 1069 if ((TREE_CODE (expr_type) == INTEGER_TYPE && TREE_CODE (type) == REAL_TYPE) || 1070 (TREE_CODE (expr_type) == REAL_TYPE && TREE_CODE (type) == INTEGER_TYPE) || 1071 (TREE_CODE (expr_type) == REAL_TYPE && TREE_CODE (type) == REAL_TYPE)) 1072 return convert (type, expr); 1073 1074 /* FIXME: Don't know if this is correct */ 1075 /* Don't allow conversions to or from REAL with others then integer */ 1076 if (TREE_CODE (type) == REAL_TYPE) 1077 { 1078 error ("cannot convert to float"); 1079 return error_mark_node; 1080 } 1081 else if (TREE_CODE (expr_type) == REAL_TYPE) 1082 { 1083 error ("cannot convert float to this mode"); 1084 return error_mark_node; 1085 } 1086 1087 if (expr_type_size == type_size && CH_REFERABLE (expr)) 1088 goto do_location_conversion; 1089 1090 type_is_discrete 1091 = discrete_type_p (type) || TREE_CODE (type) == POINTER_TYPE; 1092 expr_type_is_discrete 1093 = discrete_type_p (expr_type) || TREE_CODE (expr_type) == POINTER_TYPE; 1094 if (expr_type_is_discrete && type_is_discrete) 1095 { 1096 /* do an overflow check 1097 FIXME: is this always neccessary ??? */ 1098 /* FIXME: don't do range chacking when target type is PTR. 1099 PTR doesn't have MIN and MAXVALUE. result is sigsegv. */ 1100 if (range_checking && type != ptr_type_node) 1101 { 1102 tree tmp = expr; 1103 1104 STRIP_NOPS (tmp); 1105 if (TREE_CONSTANT (tmp) && TREE_CODE (tmp) != ADDR_EXPR) 1106 { 1107 if (compare_int_csts (LT_EXPR, tmp, TYPE_MIN_VALUE (type)) || 1108 compare_int_csts (GT_EXPR, tmp, TYPE_MAX_VALUE (type))) 1109 { 1110 error ("OVERFLOW in expression conversion"); 1111 return error_mark_node; 1112 } 1113 } 1114 else 1115 { 1116 int cond1 = tree_int_cst_lt (TYPE_SIZE (type), 1117 TYPE_SIZE (expr_type)); 1118 int cond2 = TREE_UNSIGNED (type) && (! TREE_UNSIGNED (expr_type)); 1119 int cond3 = (! TREE_UNSIGNED (type)) 1120 && TREE_UNSIGNED (expr_type) 1121 && tree_int_cst_equal (TYPE_SIZE (type), 1122 TYPE_SIZE (expr_type)); 1123 int cond4 = TREE_TYPE (type) && type_is_discrete; 1124 1125 if (cond1 || cond2 || cond3 || cond4) 1126 { 1127 tree type_min = TYPE_MIN_VALUE (type); 1128 tree type_max = TYPE_MAX_VALUE (type); 1129 1130 expr = save_if_needed (expr); 1131 if (expr && type_min && type_max) 1132 { 1133 tree check = test_range (expr, type_min, type_max); 1134 if (!integer_zerop (check)) 1135 { 1136 if (current_function_decl == NULL_TREE) 1137 { 1138 if (TREE_CODE (check) == INTEGER_CST) 1139 error ("overflow (not inside function)"); 1140 else 1141 warning ("possible overflow (not inside function)"); 1142 } 1143 else 1144 { 1145 if (TREE_CODE (check) == INTEGER_CST) 1146 warning ("expression will always cause OVERFLOW"); 1147 expr = check_expression (expr, check, 1148 ridpointers[(int) RID_OVERFLOW]); 1149 } 1150 } 1151 } 1152 } 1153 } 1154 } 1155 return convert (type, expr); 1156 } 1157 1158 if (TREE_CODE (expr) == INTEGER_CST && expr_type_size != type_size) 1159 { 1160 /* There should probably be a pedwarn here ... */ 1161 tree itype = type_for_size (type_size * BITS_PER_UNIT, 1); 1162 if (itype) 1163 { 1164 expr = convert (itype, expr); 1165 expr_type = TREE_TYPE (expr); 1166 expr_type_size= type_size; 1167 } 1168 } 1169 1170 /* If expr is a constant of the right size, use it to to 1171 initialize a static variable. */ 1172 if (expr_type_size == type_size && TREE_CONSTANT (expr) && !pedantic) 1173 { 1174 unsigned char *buffer = (unsigned char*) alloca (type_size); 1175 tree value; 1176 bzero (buffer, type_size); 1177 if (!expand_constant_to_buffer (expr, buffer, type_size)) 1178 { 1179 error ("not implemented: constant conversion from that kind of expression"); 1180 return error_mark_node; 1181 } 1182 value = extract_constant_from_buffer (type, buffer, type_size); 1183 if (value == NULL_TREE) 1184 { 1185 error ("not implemented: constant conversion to that kind of mode"); 1186 return error_mark_node; 1187 } 1188 return value; 1189 } 1190 1191 if (!CH_REFERABLE (expr) && expr_type_size == type_size) 1192 { 1193 tree temp = decl_temp1 (get_unique_identifier ("CAST"), 1194 TREE_TYPE (expr), 0, 0, 0, 0); 1195 tree convert1 = build_chill_modify_expr (temp, expr); 1196 pedwarn ("non-standard, non-portable value conversion"); 1197 return build (COMPOUND_EXPR, type, convert1, 1198 build_chill_cast (type, temp)); 1199 } 1200 1201 if (CH_REFERABLE (expr) && expr_type_size != type_size) 1202 error ("location conversion between differently-sized modes"); 1203 else 1204 error ("unsupported value conversion"); 1205 return error_mark_node; 1206 1207 do_location_conversion: 1208 /* To avoid confusing other parts of gcc, 1209 represent this as the C expression: *(TYPE*)EXPR. */ 1210 mark_addressable (expr); 1211 expr = build1 (INDIRECT_REF, type, 1212 build1 (NOP_EXPR, build_pointer_type (type), 1213 build1 (ADDR_EXPR, build_pointer_type (expr_type), 1214 expr))); 1215 TREE_READONLY (expr) = TYPE_READONLY (type); 1216 return expr; 1217} 1218 1219/* 1220 * given a set_type, build an integer array from it that C will grok. 1221 */ 1222tree 1223build_array_from_set (type) 1224 tree type; 1225{ 1226 tree bytespint, bit_array_size, int_array_count; 1227 1228 if (type == NULL_TREE || type == error_mark_node || TREE_CODE (type) != SET_TYPE) 1229 return error_mark_node; 1230 1231 bytespint = build_int_2 (HOST_BITS_PER_INT / HOST_BITS_PER_CHAR, 0); 1232 bit_array_size = size_in_bytes (type); 1233 int_array_count = fold (size_binop (TRUNC_DIV_EXPR, bit_array_size, 1234 bytespint)); 1235 if (integer_zerop (int_array_count)) 1236 int_array_count = size_one_node; 1237 type = build_array_type (integer_type_node, 1238 build_index_type (int_array_count)); 1239 return type; 1240} 1241 1242 1243tree 1244build_chill_bin_type (size) 1245 tree size; 1246{ 1247#if 0 1248 int isize; 1249 1250 if (TREE_CODE (size) != INTEGER_CST 1251 || (isize = TREE_INT_CST_LOW (size), isize <= 0)) 1252 { 1253 error ("operand to bin must be a non-negative integer literal"); 1254 return error_mark_node; 1255 } 1256 if (isize <= TYPE_PRECISION (unsigned_char_type_node)) 1257 return unsigned_char_type_node; 1258 if (isize <= TYPE_PRECISION (short_unsigned_type_node)) 1259 return short_unsigned_type_node; 1260 if (isize <= TYPE_PRECISION (unsigned_type_node)) 1261 return unsigned_type_node; 1262 if (isize <= TYPE_PRECISION (long_unsigned_type_node)) 1263 return long_unsigned_type_node; 1264 if (isize <= TYPE_PRECISION (long_long_unsigned_type_node)) 1265 return long_long_unsigned_type_node; 1266 error ("size %d of BIN too big - no such integer mode", isize); 1267 return error_mark_node; 1268#endif 1269 tree bintype; 1270 1271 if (pass == 1) 1272 { 1273 bintype = make_node (INTEGER_TYPE); 1274 TREE_TYPE (bintype) = ridpointers[(int) RID_BIN]; 1275 TYPE_MIN_VALUE (bintype) = size; 1276 TYPE_MAX_VALUE (bintype) = size; 1277 } 1278 else 1279 { 1280 error ("BIN in pass 2"); 1281 return error_mark_node; 1282 } 1283 return bintype; 1284} 1285 1286tree 1287chill_expand_tuple (type, constructor) 1288 tree type, constructor; 1289{ 1290 char *name; 1291 tree nonreft = type; 1292 1293 if (TYPE_NAME (type) != NULL_TREE) 1294 { 1295 if (TREE_CODE (TYPE_NAME (type)) == IDENTIFIER_NODE) 1296 name = IDENTIFIER_POINTER (TYPE_NAME (type)); 1297 else 1298 name = IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (type))); 1299 } 1300 else 1301 name = ""; 1302 1303 /* get to actual underlying type for digest_init */ 1304 while (nonreft && TREE_CODE (nonreft) == REFERENCE_TYPE) 1305 nonreft = TREE_TYPE (nonreft); 1306 1307 if (TREE_CODE (nonreft) == ARRAY_TYPE 1308 || TREE_CODE (nonreft) == RECORD_TYPE 1309 || TREE_CODE (nonreft) == SET_TYPE) 1310 return convert (nonreft, constructor); 1311 else 1312 { 1313 error ("mode of tuple is neither ARRAY, STRUCT, nor POWERSET"); 1314 return error_mark_node; 1315 } 1316} 1317 1318/* This function classifies an expr into the Null class, 1319 the All class, the M-Value, the M-derived, or the M-reference class. 1320 It probably has some inaccuracies. */ 1321 1322struct ch_class 1323chill_expr_class (expr) 1324 tree expr; 1325{ 1326 struct ch_class class; 1327 /* The Null class contains the NULL pointer constant (only). */ 1328 if (expr == null_pointer_node) 1329 { 1330 class.kind = CH_NULL_CLASS; 1331 class.mode = NULL_TREE; 1332 return class; 1333 } 1334 1335 /* The All class contains the <undefined value> "*". */ 1336 if (TREE_CODE (expr) == UNDEFINED_EXPR) 1337 { 1338 class.kind = CH_ALL_CLASS; 1339 class.mode = NULL_TREE; 1340 return class; 1341 } 1342 1343 if (CH_DERIVED_FLAG (expr)) 1344 { 1345 class.kind = CH_DERIVED_CLASS; 1346 class.mode = TREE_TYPE (expr); 1347 return class; 1348 } 1349 1350 /* The M-Reference contains <references location> (address-of) expressions. 1351 Note that something that's been converted to a reference doesn't count. */ 1352 if (TREE_CODE (expr) == ADDR_EXPR 1353 && TREE_CODE (TREE_TYPE (expr)) != REFERENCE_TYPE) 1354 { 1355 class.kind = CH_REFERENCE_CLASS; 1356 class.mode = TREE_TYPE (TREE_TYPE (expr)); 1357 return class; 1358 } 1359 1360 /* The M-Value class contains expressions with a known, specific mode M. */ 1361 class.kind = CH_VALUE_CLASS; 1362 class.mode = TREE_TYPE (expr); 1363 return class; 1364} 1365 1366/* Returns >= 1 iff REF is a location. Return 2 if it is referable. */ 1367 1368int chill_location (ref) 1369 tree ref; 1370{ 1371 register enum tree_code code = TREE_CODE (ref); 1372 1373 switch (code) 1374 { 1375 case REALPART_EXPR: 1376 case IMAGPART_EXPR: 1377 case ARRAY_REF: 1378 case PACKED_ARRAY_REF: 1379 case COMPONENT_REF: 1380 case NOP_EXPR: /* RETYPE_EXPR */ 1381 return chill_location (TREE_OPERAND (ref, 0)); 1382 case COMPOUND_EXPR: 1383 return chill_location (TREE_OPERAND (ref, 1)); 1384 1385 case BIT_FIELD_REF: 1386 case SLICE_EXPR: 1387 /* A bit-string slice is nor referable. */ 1388 return chill_location (TREE_OPERAND (ref, 0)) == 0 ? 0 : 1; 1389 1390 case CONSTRUCTOR: 1391 case STRING_CST: 1392 return 0; 1393 1394 case INDIRECT_REF: 1395 case VAR_DECL: 1396 case PARM_DECL: 1397 case RESULT_DECL: 1398 case ERROR_MARK: 1399 if (TREE_CODE (TREE_TYPE (ref)) != FUNCTION_TYPE 1400 && TREE_CODE (TREE_TYPE (ref)) != METHOD_TYPE) 1401 return 2; 1402 break; 1403 1404 default: 1405 break; 1406 } 1407 return 0; 1408} 1409 1410int 1411chill_referable (val) 1412 tree val; 1413{ 1414 return chill_location (val) > 1; 1415} 1416 1417/* Make a copy of MODE, but with the given NOVELTY. */ 1418 1419tree 1420copy_novelty (novelty, mode) 1421 tree novelty, mode; 1422{ 1423 if (CH_NOVELTY (mode) != novelty) 1424 { 1425 mode = copy_node (mode); 1426 TYPE_MAIN_VARIANT (mode) = mode; 1427 TYPE_NEXT_VARIANT (mode) = 0; 1428 TYPE_POINTER_TO (mode) = 0; 1429 TYPE_REFERENCE_TO (mode) = 0; 1430 SET_CH_NOVELTY (mode, novelty); 1431 } 1432 return mode; 1433} 1434 1435 1436struct mode_chain 1437{ 1438 struct mode_chain *prev; 1439 tree mode1, mode2; 1440}; 1441 1442/* Tests if MODE1 and MODE2 are SIMILAR. 1443 This is more or less as defined in the Blue Book, though 1444 see FIXME for parts that are unfinished. 1445 CHAIN is used to catch infinite recursion: It is a list of pairs 1446 of mode arguments to calls to chill_similar "outer" to this call. */ 1447 1448int 1449chill_similar (mode1, mode2, chain) 1450 tree mode1, mode2; 1451 struct mode_chain *chain; 1452{ 1453 int varying1, varying2; 1454 tree t1, t2; 1455 struct mode_chain *link, node; 1456 if (mode1 == NULL_TREE || mode2 == NULL_TREE) 1457 return 0; 1458 1459 while (TREE_CODE (mode1) == REFERENCE_TYPE) 1460 mode1 = TREE_TYPE (mode1); 1461 while (TREE_CODE (mode2) == REFERENCE_TYPE) 1462 mode2 = TREE_TYPE (mode2); 1463 1464 /* Range modes are similar to their parent types. */ 1465 while (TREE_CODE (mode1) == INTEGER_TYPE && TREE_TYPE (mode1) != NULL_TREE) 1466 mode1 = TREE_TYPE (mode1); 1467 while (TREE_CODE (mode2) == INTEGER_TYPE && TREE_TYPE (mode2) != NULL_TREE) 1468 mode2 = TREE_TYPE (mode2); 1469 1470 1471 /* see Z.200 sections 12.1.2.2 and 13.2 - all integer precisions 1472 are similar to INT and to each other */ 1473 if (mode1 == mode2 || 1474 (TREE_CODE (mode1) == INTEGER_TYPE && TREE_CODE (mode2) == INTEGER_TYPE)) 1475 return 1; 1476 1477 /* This guards against certain kinds of recursion. 1478 For example: 1479 SYNMODE a = STRUCT ( next REF a ); 1480 SYNMODE b = STRUCT ( next REF b ); 1481 These moes are similar, but will get an infite recursion trying 1482 to prove that. So, if we are recursing, assume the moes are similar. 1483 If they are not, we'll find some other discrepancy. */ 1484 for (link = chain; link != NULL; link = link->prev) 1485 { 1486 if (link->mode1 == mode1 && link->mode2 == mode2) 1487 return 1; 1488 } 1489 1490 node.mode1 = mode1; 1491 node.mode2 = mode2; 1492 node.prev = chain; 1493 1494 varying1 = chill_varying_type_p (mode1); 1495 varying2 = chill_varying_type_p (mode2); 1496 /* FIXME: This isn't quite strict enough. */ 1497 if ((varying1 && varying2) 1498 || (varying1 && TREE_CODE (mode2) == ARRAY_TYPE) 1499 || (varying2 && TREE_CODE (mode1) == ARRAY_TYPE)) 1500 return 1; 1501 1502 if (TREE_CODE(mode1) != TREE_CODE(mode2)) 1503 { 1504 if (flag_old_strings) 1505 { 1506 /* The recursion is to handle varying strings. */ 1507 if ((TREE_CODE (mode1) == CHAR_TYPE 1508 && CH_SIMILAR (mode2, string_one_type_node)) 1509 || (TREE_CODE (mode2) == CHAR_TYPE 1510 && CH_SIMILAR (mode1, string_one_type_node))) 1511 return 1; 1512 if ((TREE_CODE (mode1) == BOOLEAN_TYPE 1513 && CH_SIMILAR (mode2, bitstring_one_type_node)) 1514 || (TREE_CODE (mode2) == BOOLEAN_TYPE 1515 && CH_SIMILAR (mode1, bitstring_one_type_node))) 1516 return 1; 1517 } 1518 if (TREE_CODE (mode1) == FUNCTION_TYPE 1519 && TREE_CODE (mode2) == POINTER_TYPE 1520 && TREE_CODE (TREE_TYPE (mode2)) == FUNCTION_TYPE) 1521 mode2 = TREE_TYPE (mode2); 1522 else if (TREE_CODE (mode2) == FUNCTION_TYPE 1523 && TREE_CODE (mode1) == POINTER_TYPE 1524 && TREE_CODE (TREE_TYPE (mode1)) == FUNCTION_TYPE) 1525 mode1 = TREE_TYPE (mode1); 1526 else 1527 return 0; 1528 } 1529 1530 if (CH_IS_BUFFER_MODE (mode1) && CH_IS_BUFFER_MODE (mode2)) 1531 { 1532 tree len1 = max_queue_size (mode1); 1533 tree len2 = max_queue_size (mode2); 1534 return tree_int_cst_equal (len1, len2); 1535 } 1536 else if (CH_IS_EVENT_MODE (mode1) && CH_IS_EVENT_MODE (mode2)) 1537 { 1538 tree len1 = max_queue_size (mode1); 1539 tree len2 = max_queue_size (mode2); 1540 return tree_int_cst_equal (len1, len2); 1541 } 1542 else if (CH_IS_ACCESS_MODE (mode1) && CH_IS_ACCESS_MODE (mode2)) 1543 { 1544 tree index1 = access_indexmode (mode1); 1545 tree index2 = access_indexmode (mode2); 1546 tree record1 = access_recordmode (mode1); 1547 tree record2 = access_recordmode (mode2); 1548 if (! chill_read_compatible (index1, index2)) 1549 return 0; 1550 return chill_read_compatible (record1, record2); 1551 } 1552 switch ((enum chill_tree_code)TREE_CODE (mode1)) 1553 { 1554 case INTEGER_TYPE: 1555 case BOOLEAN_TYPE: 1556 case CHAR_TYPE: 1557 return 1; 1558 case ENUMERAL_TYPE: 1559 if (TYPE_VALUES (mode1) == TYPE_VALUES (mode2)) 1560 return 1; 1561 else 1562 { 1563 /* FIXME: This is more strict than z.200, which seems to 1564 allow the elements to be reordered, as long as they 1565 have the same values. */ 1566 1567 tree field1 = TYPE_VALUES (mode1); 1568 tree field2 = TYPE_VALUES (mode2); 1569 1570 while (field1 != NULL_TREE && field2 != NULL_TREE) 1571 { 1572 tree value1, value2; 1573 /* Check that the names are equal. */ 1574 if (TREE_PURPOSE (field1) != TREE_PURPOSE (field2)) 1575 break; 1576 1577 value1 = TREE_VALUE (field1); 1578 value2 = TREE_VALUE (field2); 1579 /* This isn't quite sufficient in general, but will do ... */ 1580 /* Note that proclaim_decl can cause the SET modes to be 1581 compared BEFORE they are satisfied, but otherwise 1582 chill_similar is mostly called after satisfaction. */ 1583 if (TREE_CODE (value1) == CONST_DECL) 1584 value1 = DECL_INITIAL (value1); 1585 if (TREE_CODE (value2) == CONST_DECL) 1586 value2 = DECL_INITIAL (value2); 1587 /* Check that the values are equal or both NULL. */ 1588 if (!(value1 == NULL_TREE && value2 == NULL_TREE) 1589 && (value1 == NULL_TREE || value2 == NULL_TREE 1590 || ! tree_int_cst_equal (value1, value2))) 1591 break; 1592 field1 = TREE_CHAIN (field1); 1593 field2 = TREE_CHAIN (field2); 1594 } 1595 return field1 == NULL_TREE && field2 == NULL_TREE; 1596 } 1597 case SET_TYPE: 1598 /* check for bit strings */ 1599 if (CH_BOOLS_TYPE_P (mode1)) 1600 return CH_BOOLS_TYPE_P (mode2); 1601 if (CH_BOOLS_TYPE_P (mode2)) 1602 return CH_BOOLS_TYPE_P (mode1); 1603 /* both are powerset modes */ 1604 return CH_EQUIVALENT (TYPE_DOMAIN (mode1), TYPE_DOMAIN (mode2)); 1605 1606 case POINTER_TYPE: 1607 /* Are the referenced modes equivalent? */ 1608 return !integer_zerop (chill_equivalent (TREE_TYPE (mode1), 1609 TREE_TYPE (mode2), 1610 &node)); 1611 1612 case ARRAY_TYPE: 1613 /* char for char strings */ 1614 if (CH_CHARS_TYPE_P (mode1)) 1615 return CH_CHARS_TYPE_P (mode2); 1616 if (CH_CHARS_TYPE_P (mode2)) 1617 return CH_CHARS_TYPE_P (mode1); 1618 /* array modes */ 1619 if (CH_V_EQUIVALENT (TYPE_DOMAIN (mode1), TYPE_DOMAIN (mode2)) 1620 /* Are the elements modes equivalent? */ 1621 && !integer_zerop (chill_equivalent (TREE_TYPE (mode1), 1622 TREE_TYPE (mode2), 1623 &node))) 1624 { 1625 /* FIXME: Check that element layouts are equivalent */ 1626 1627 tree count1 = fold (build (MINUS_EXPR, sizetype, 1628 TYPE_MAX_VALUE (TYPE_DOMAIN (mode1)), 1629 TYPE_MIN_VALUE (TYPE_DOMAIN (mode1)))); 1630 tree count2 = fold (build (MINUS_EXPR, sizetype, 1631 TYPE_MAX_VALUE (TYPE_DOMAIN (mode2)), 1632 TYPE_MIN_VALUE (TYPE_DOMAIN (mode2)))); 1633 tree cond = build_compare_discrete_expr (EQ_EXPR, count1, count2); 1634 if (TREE_CODE (cond) == INTEGER_CST) 1635 return !integer_zerop (cond); 1636 else 1637 { 1638#if 0 1639 extern int ignoring; 1640 if (!ignoring 1641 && range_checking 1642 && current_function_decl) 1643 return cond; 1644#endif 1645 return 1; 1646 } 1647 } 1648 return 0; 1649 1650 case RECORD_TYPE: 1651 case UNION_TYPE: 1652 for (t1 = TYPE_FIELDS (mode1), t2 = TYPE_FIELDS (mode2); 1653 t1 && t2; t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2)) 1654 { 1655 if (TREE_CODE (t1) != TREE_CODE (t2)) 1656 return 0; 1657 /* Are the field modes equivalent? */ 1658 if (integer_zerop (chill_equivalent (TREE_TYPE (t1), 1659 TREE_TYPE (t2), 1660 &node))) 1661 return 0; 1662 } 1663 return t1 == t2; 1664 1665 case FUNCTION_TYPE: 1666 if (!chill_l_equivalent (TREE_TYPE (mode1), TREE_TYPE (mode2), &node)) 1667 return 0; 1668 for (t1 = TYPE_ARG_TYPES (mode1), t2 = TYPE_ARG_TYPES (mode2); 1669 t1 != NULL_TREE && t2 != NULL_TREE; 1670 t1 = TREE_CHAIN (t1), t2 = TREE_CHAIN (t2)) 1671 { 1672 tree attr1 = TREE_PURPOSE (t1) 1673 ? TREE_PURPOSE (t1) : ridpointers[(int) RID_IN]; 1674 tree attr2 = TREE_PURPOSE (t2) 1675 ? TREE_PURPOSE (t2) : ridpointers[(int) RID_IN]; 1676 if (attr1 != attr2) 1677 return 0; 1678 if (!chill_l_equivalent (TREE_VALUE (t1), TREE_VALUE (t2), &node)) 1679 return 0; 1680 } 1681 if (t1 != t2) /* Both NULL_TREE */ 1682 return 0; 1683 /* check list of exception names */ 1684 t1 = TYPE_RAISES_EXCEPTIONS (mode1); 1685 t2 = TYPE_RAISES_EXCEPTIONS (mode2); 1686 if (t1 == NULL_TREE && t2 != NULL_TREE) 1687 return 0; 1688 if (t1 != NULL_TREE && t2 == NULL_TREE) 1689 return 0; 1690 if (list_length (t1) != list_length (t2)) 1691 return 0; 1692 while (t1 != NULL_TREE) 1693 { 1694 if (value_member (TREE_VALUE (t1), t2) == NULL_TREE) 1695 return 0; 1696 t1 = TREE_CHAIN (t1); 1697 } 1698 /* FIXME: Should also check they have the same RECURSIVITY */ 1699 return 1; 1700 1701 default: 1702 ; 1703#if 0 1704 /* Need to handle row modes, instance modes, 1705 association modes, access modes, text modes, 1706 duration modes, absolute time modes, structure modes, 1707 parameterized structure modes */ 1708#endif 1709 } 1710 return 1; 1711} 1712 1713/* Return a node that is true iff MODE1 and MODE2 are equivalent. 1714 This is normally boolean_true_node or boolean_false_node, 1715 but can be dynamic for dynamic types. 1716 CHAIN is as for chill_similar. */ 1717 1718tree 1719chill_equivalent (mode1, mode2, chain) 1720 tree mode1, mode2; 1721 struct mode_chain *chain; 1722{ 1723 int varying1, varying2; 1724 int is_string1, is_string2; 1725 tree base_mode1, base_mode2; 1726 1727 /* Are the modes v-equivalent? */ 1728#if 0 1729 if (!chill_similar (mode1, mode2, chain) 1730 || CH_NOVELTY(mode1) != CH_NOVELTY(mode2)) 1731 return boolean_false_node; 1732#endif 1733 if (!chill_similar (mode1, mode2, chain)) 1734 return boolean_false_node; 1735 else if (TREE_CODE (mode2) == FUNCTION_TYPE 1736 && TREE_CODE (mode1) == POINTER_TYPE 1737 && TREE_CODE (TREE_TYPE (mode1)) == FUNCTION_TYPE) 1738 /* don't check novelty in this case to avoid error in case of 1739 NEWMODE'd proceduremode gets assigned a function */ 1740 return boolean_true_node; 1741 else if (CH_NOVELTY(mode1) != CH_NOVELTY(mode2)) 1742 return boolean_false_node; 1743 1744 varying1 = chill_varying_type_p (mode1); 1745 varying2 = chill_varying_type_p (mode2); 1746 1747 if (varying1 != varying2) 1748 return boolean_false_node; 1749 base_mode1 = varying1 ? CH_VARYING_ARRAY_TYPE (mode1) : mode1; 1750 base_mode2 = varying2 ? CH_VARYING_ARRAY_TYPE (mode2) : mode2; 1751 is_string1 = CH_STRING_TYPE_P (base_mode1); 1752 is_string2 = CH_STRING_TYPE_P (base_mode2); 1753 if (is_string1 || is_string2) 1754 { 1755 if (is_string1 != is_string2) 1756 return boolean_false_node; 1757 return fold (build (EQ_EXPR, boolean_type_node, 1758 TYPE_SIZE (base_mode1), 1759 TYPE_SIZE (base_mode2))); 1760 } 1761 1762 /* && some more stuff FIXME! */ 1763 if (TREE_CODE(mode1) == INTEGER_TYPE || TREE_CODE(mode2) == INTEGER_TYPE) 1764 { 1765 if (TREE_CODE(mode1) != INTEGER_TYPE || TREE_CODE(mode2) != INTEGER_TYPE) 1766 return boolean_false_node; 1767 /* If one is a range, the other has to be a range. */ 1768 if ((TREE_TYPE (mode1) != NULL_TREE) != (TREE_TYPE (mode2) != NULL_TREE)) 1769 return boolean_false_node; 1770 if (TYPE_PRECISION (mode1) != TYPE_PRECISION (mode2)) 1771 return boolean_false_node; 1772 if (!tree_int_cst_equal (TYPE_MIN_VALUE (mode1), TYPE_MIN_VALUE (mode2))) 1773 return boolean_false_node; 1774 if (!tree_int_cst_equal (TYPE_MAX_VALUE (mode1), TYPE_MAX_VALUE (mode2))) 1775 return boolean_false_node; 1776 } 1777 return boolean_true_node; 1778} 1779 1780static int 1781chill_l_equivalent (mode1, mode2, chain) 1782 tree mode1, mode2; 1783 struct mode_chain *chain; 1784{ 1785 /* Are the modes equivalent? */ 1786 if (integer_zerop (chill_equivalent (mode1, mode2, chain))) 1787 return 0; 1788 if (TYPE_READONLY (mode1) != TYPE_READONLY (mode2)) 1789 return 0; 1790#if 0 1791 ... other conditions ...; 1792#endif 1793 return 1; 1794} 1795 1796/* See Z200 12.1.2.12 */ 1797 1798int 1799chill_read_compatible (modeM, modeN) 1800 tree modeM, modeN; 1801{ 1802 while (TREE_CODE (modeM) == REFERENCE_TYPE) 1803 modeM = TREE_TYPE (modeM); 1804 while (TREE_CODE (modeN) == REFERENCE_TYPE) 1805 modeN = TREE_TYPE (modeN); 1806 1807 if (!CH_EQUIVALENT (modeM, modeN)) 1808 return 0; 1809 if (TYPE_READONLY (modeN)) 1810 { 1811 if (!TYPE_READONLY (modeM)) 1812 return 0; 1813 if (CH_IS_BOUND_REFERENCE_MODE (modeM) 1814 && CH_IS_BOUND_REFERENCE_MODE (modeN)) 1815 { 1816 return chill_l_equivalent (TREE_TYPE (modeM), TREE_TYPE (modeN), 0); 1817 } 1818#if 0 1819 ...; 1820#endif 1821 } 1822 return 1; 1823} 1824 1825/* Tests if MODE is compatible with the class of EXPR. 1826 Cfr. Chill Blue Book 12.1.2.15. */ 1827 1828int 1829chill_compatible (expr, mode) 1830 tree expr, mode; 1831{ 1832 struct ch_class class; 1833 1834 if (expr == NULL_TREE || TREE_CODE (expr) == ERROR_MARK) 1835 return 0; 1836 if (mode == NULL_TREE || TREE_CODE (mode) == ERROR_MARK) 1837 return 0; 1838 1839 while (TREE_CODE (mode) == REFERENCE_TYPE) 1840 mode = TREE_TYPE (mode); 1841 1842 if (TREE_TYPE (expr) == NULL_TREE) 1843 { 1844 if (TREE_CODE (expr) == CONSTRUCTOR) 1845 return TREE_CODE (mode) == RECORD_TYPE 1846 || ((TREE_CODE (mode) == SET_TYPE || TREE_CODE (mode) == ARRAY_TYPE) 1847 && ! TYPE_STRING_FLAG (mode)); 1848 else 1849 return TREE_CODE (expr) == CASE_EXPR || TREE_CODE (expr) == COND_EXPR; 1850 } 1851 1852 class = chill_expr_class (expr); 1853 switch (class.kind) 1854 { 1855 case CH_ALL_CLASS: 1856 return 1; 1857 case CH_NULL_CLASS: 1858 return CH_IS_REFERENCE_MODE (mode) || CH_IS_PROCEDURE_MODE (mode) 1859 || CH_IS_INSTANCE_MODE (mode); 1860 case CH_VALUE_CLASS: 1861 if (CH_HAS_REFERENCING_PROPERTY (mode)) 1862 return CH_RESTRICTABLE_TO(mode, class.mode); 1863 else 1864 return CH_V_EQUIVALENT(mode, class.mode); 1865 case CH_DERIVED_CLASS: 1866 return CH_SIMILAR (class.mode, mode); 1867 case CH_REFERENCE_CLASS: 1868 if (!CH_IS_REFERENCE_MODE (mode)) 1869 return 0; 1870#if 0 1871 /* FIXME! */ 1872 if (class.mode is a row mode) 1873 ...; 1874 else if (class.mode is not a static mode) 1875 return 0; /* is this possible? FIXME */ 1876#endif 1877 return !CH_IS_BOUND_REFERENCE_MODE(mode) 1878 || CH_READ_COMPATIBLE (TREE_TYPE (mode), class.mode); 1879 } 1880 return 0; /* ERROR! */ 1881} 1882 1883/* Tests if the class of of EXPR1 and EXPR2 are compatible. 1884 Cfr. Chill Blue Book 12.1.2.16. */ 1885 1886int 1887chill_compatible_classes (expr1, expr2) 1888 tree expr1, expr2; 1889{ 1890 struct ch_class temp; 1891 struct ch_class class1, class2; 1892 class1 = chill_expr_class (expr1); 1893 class2 = chill_expr_class (expr2); 1894 1895 switch (class1.kind) 1896 { 1897 case CH_ALL_CLASS: 1898 return 1; 1899 case CH_NULL_CLASS: 1900 switch (class2.kind) 1901 { 1902 case CH_ALL_CLASS: 1903 case CH_NULL_CLASS: 1904 case CH_REFERENCE_CLASS: 1905 return 1; 1906 case CH_VALUE_CLASS: 1907 case CH_DERIVED_CLASS: 1908 goto rule4; 1909 } 1910 case CH_REFERENCE_CLASS: 1911 switch (class2.kind) 1912 { 1913 case CH_ALL_CLASS: 1914 case CH_NULL_CLASS: 1915 return 1; 1916 case CH_REFERENCE_CLASS: 1917 return CH_EQUIVALENT (class1.mode, class2.mode); 1918 case CH_VALUE_CLASS: 1919 goto rule6; 1920 case CH_DERIVED_CLASS: 1921 return 0; 1922 } 1923 case CH_DERIVED_CLASS: 1924 switch (class2.kind) 1925 { 1926 case CH_ALL_CLASS: 1927 return 1; 1928 case CH_VALUE_CLASS: 1929 case CH_DERIVED_CLASS: 1930 return CH_SIMILAR (class1.mode, class2.mode); 1931 case CH_NULL_CLASS: 1932 class2 = class1; 1933 goto rule4; 1934 case CH_REFERENCE_CLASS: 1935 return 0; 1936 } 1937 case CH_VALUE_CLASS: 1938 switch (class2.kind) 1939 { 1940 case CH_ALL_CLASS: 1941 return 1; 1942 case CH_DERIVED_CLASS: 1943 return CH_SIMILAR (class1.mode, class2.mode); 1944 case CH_VALUE_CLASS: 1945 return CH_V_EQUIVALENT (class1.mode, class2.mode); 1946 case CH_NULL_CLASS: 1947 class2 = class1; 1948 goto rule4; 1949 case CH_REFERENCE_CLASS: 1950 temp = class1; class1 = class2; class2 = temp; 1951 goto rule6; 1952 } 1953 } 1954 rule4: 1955 /* The Null class is Compatible with the M-derived class or M-value class 1956 if and only if M is a reference mdoe, procedure mode or instance mode.*/ 1957 return CH_IS_REFERENCE_MODE (class2.mode) 1958 || CH_IS_PROCEDURE_MODE (class2.mode) 1959 || CH_IS_INSTANCE_MODE (class2.mode); 1960 1961 rule6: 1962 /* The M-reference class is compatible with the N-value class if and 1963 only if N is a reference mode and ... */ 1964 if (!CH_IS_REFERENCE_MODE (class2.mode)) 1965 return 0; 1966 if (1) /* If M is a static mode - FIXME */ 1967 { 1968 if (!CH_IS_BOUND_REFERENCE_MODE (class2.mode)) 1969 return 1; 1970 if (CH_EQUIVALENT (TREE_TYPE (class2.mode), class1.mode)) 1971 return 1; 1972 } 1973 /* If N is a row mode whose .... FIXME */ 1974 return 0; 1975} 1976 1977/* Cfr. Blue Book 12.1.1.6, with some "extensions." */ 1978 1979tree 1980chill_root_mode (mode) 1981 tree mode; 1982{ 1983 /* Reference types are not user-visible types. 1984 This seems like a good place to get rid of them. */ 1985 if (TREE_CODE (mode) == REFERENCE_TYPE) 1986 mode = TREE_TYPE (mode); 1987 1988 while (TREE_CODE (mode) == INTEGER_TYPE && TREE_TYPE (mode) != NULL_TREE) 1989 mode = TREE_TYPE (mode); /* a sub-range */ 1990 1991 /* This extension in not in the Blue Book - which only has a 1992 single Integer type. 1993 We should probably use chill_integer_type_node rather 1994 than integer_type_node, but that is likely to bomb. 1995 At some point, these will become the same, I hope. FIXME */ 1996 if (TREE_CODE (mode) == INTEGER_TYPE 1997 && TYPE_PRECISION (mode) < TYPE_PRECISION (integer_type_node) 1998 && CH_NOVELTY (mode) == NULL_TREE) 1999 mode = integer_type_node; 2000 2001 if (TREE_CODE (mode) == FUNCTION_TYPE) 2002 return build_pointer_type (mode); 2003 2004 return mode; 2005} 2006 2007/* Cfr. Blue Book 12.1.1.7. */ 2008 2009tree 2010chill_resulting_mode (mode1, mode2) 2011 tree mode1, mode2; 2012{ 2013 mode1 = CH_ROOT_MODE (mode1); 2014 mode2 = CH_ROOT_MODE (mode2); 2015 if (chill_varying_type_p (mode1)) 2016 return mode1; 2017 if (chill_varying_type_p (mode2)) 2018 return mode2; 2019 return mode1; 2020} 2021 2022/* Cfr. Blue Book (z200, 1988) 12.1.1.7 Resulting class. */ 2023 2024struct ch_class 2025chill_resulting_class (class1, class2) 2026 struct ch_class class1, class2; 2027{ 2028 struct ch_class class; 2029 switch (class1.kind) 2030 { 2031 case CH_VALUE_CLASS: 2032 switch (class2.kind) 2033 { 2034 case CH_DERIVED_CLASS: 2035 case CH_ALL_CLASS: 2036 class.kind = CH_VALUE_CLASS; 2037 class.mode = CH_ROOT_MODE (class1.mode); 2038 return class; 2039 case CH_VALUE_CLASS: 2040 class.kind = CH_VALUE_CLASS; 2041 class.mode 2042 = CH_ROOT_MODE (CH_RESULTING_MODE (class1.mode, class2.mode)); 2043 return class; 2044 default: 2045 break; 2046 } 2047 break; 2048 case CH_DERIVED_CLASS: 2049 switch (class2.kind) 2050 { 2051 case CH_VALUE_CLASS: 2052 class.kind = CH_VALUE_CLASS; 2053 class.mode = CH_ROOT_MODE (class2.mode); 2054 return class; 2055 case CH_DERIVED_CLASS: 2056 class.kind = CH_DERIVED_CLASS; 2057 class.mode = CH_RESULTING_MODE (class1.mode, class2.mode); 2058 return class; 2059 case CH_ALL_CLASS: 2060 class.kind = CH_DERIVED_CLASS; 2061 class.mode = CH_ROOT_MODE (class1.mode); 2062 return class; 2063 default: 2064 break; 2065 } 2066 break; 2067 case CH_ALL_CLASS: 2068 switch (class2.kind) 2069 { 2070 case CH_VALUE_CLASS: 2071 class.kind = CH_VALUE_CLASS; 2072 class.mode = CH_ROOT_MODE (class2.mode); 2073 return class; 2074 case CH_ALL_CLASS: 2075 class.kind = CH_ALL_CLASS; 2076 class.mode = NULL_TREE; 2077 return class; 2078 case CH_DERIVED_CLASS: 2079 class.kind = CH_DERIVED_CLASS; 2080 class.mode = CH_ROOT_MODE (class2.mode); 2081 return class; 2082 default: 2083 break; 2084 } 2085 break; 2086 default: 2087 break; 2088 } 2089 error ("internal error in chill_root_resulting_mode"); 2090 class.kind = CH_VALUE_CLASS; 2091 class.mode = CH_ROOT_MODE (class1.mode); 2092 return class; 2093} 2094 2095 2096/* 2097 * See Z.200, section 6.3, static conditions. This function 2098 * returns bool_false_node if the condition is not met at compile time, 2099 * bool_true_node if the condition is detectably met at compile time 2100 * an expression if a runtime check would be required or was generated. 2101 * It should only be called with string modes and values. 2102 */ 2103tree 2104string_assignment_condition (lhs_mode, rhs_value) 2105 tree lhs_mode, rhs_value; 2106{ 2107 tree lhs_size, rhs_size, cond; 2108 tree rhs_mode = TREE_TYPE (rhs_value); 2109 int lhs_varying = chill_varying_type_p (lhs_mode); 2110 2111 if (lhs_varying) 2112 lhs_size = size_in_bytes (CH_VARYING_ARRAY_TYPE (lhs_mode)); 2113 else if (CH_BOOLS_TYPE_P (lhs_mode)) 2114 lhs_size = TYPE_MAX_VALUE (TYPE_DOMAIN (lhs_mode)); 2115 else 2116 lhs_size = size_in_bytes (lhs_mode); 2117 lhs_size = convert (chill_unsigned_type_node, lhs_size); 2118 2119 if (rhs_mode && TREE_CODE (rhs_mode) == REFERENCE_TYPE) 2120 rhs_mode = TREE_TYPE (rhs_mode); 2121 if (rhs_mode == NULL_TREE) 2122 { 2123 /* actually, count constructor's length */ 2124 abort (); 2125 } 2126 else if (chill_varying_type_p (rhs_mode)) 2127 rhs_size = build_component_ref (rhs_value, var_length_id); 2128 else if (CH_BOOLS_TYPE_P (rhs_mode)) 2129 rhs_size = TYPE_MAX_VALUE (TYPE_DOMAIN (rhs_mode)); 2130 else 2131 rhs_size = size_in_bytes (rhs_mode); 2132 rhs_size = convert (chill_unsigned_type_node, rhs_size); 2133 2134 /* validity condition */ 2135 cond = fold (build (lhs_varying ? GE_EXPR : EQ_EXPR, 2136 boolean_type_node, lhs_size, rhs_size)); 2137 return cond; 2138} 2139 2140/* 2141 * take a basic CHILL type and wrap it in a VARYING structure. 2142 * Be sure the length field is initialized. Return the wrapper. 2143 */ 2144tree 2145build_varying_struct (type) 2146 tree type; 2147{ 2148 tree decl1, decl2, result; 2149 2150 if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK) 2151 return error_mark_node; 2152 2153 decl1 = build_decl (FIELD_DECL, var_length_id, chill_integer_type_node); 2154 decl2 = build_decl (FIELD_DECL, var_data_id, type); 2155 TREE_CHAIN (decl1) = decl2; 2156 TREE_CHAIN (decl2) = NULL_TREE; 2157 result = build_chill_struct_type (decl1); 2158 2159 /* mark this so we don't complain about missing initializers. 2160 It's fine for a VARYING array to be partially initialized.. */ 2161 C_TYPE_VARIABLE_SIZE(type) = 1; 2162 return result; 2163} 2164 2165 2166/* 2167 * This is the struct type that forms the runtime initializer 2168 * list. There's at least one of these generated per module. 2169 * It's attached to the global initializer list by the module's 2170 * 'constructor' code. Should only be called in pass 2. 2171 */ 2172tree 2173build_init_struct () 2174{ 2175 tree decl1, decl2, result; 2176 /* We temporarily reset the maximum_field_alignment to zero so the 2177 compiler's init data structures can be compatible with the 2178 run-time system, even when we're compiling with -fpack. */ 2179 extern int maximum_field_alignment; 2180 int save_maximum_field_alignment = maximum_field_alignment; 2181 maximum_field_alignment = 0; 2182 2183 decl1 = build_decl (FIELD_DECL, get_identifier ("__INIT_ENTRY"), 2184 build_chill_pointer_type ( 2185 build_function_type (void_type_node, NULL_TREE))); 2186 2187 decl2 = build_decl (FIELD_DECL, get_identifier ("__INIT_NEXT"), 2188 build_chill_pointer_type (void_type_node)); 2189 2190 TREE_CHAIN (decl1) = decl2; 2191 TREE_CHAIN (decl2) = NULL_TREE; 2192 result = build_chill_struct_type (decl1); 2193 maximum_field_alignment = save_maximum_field_alignment; 2194 return result; 2195} 2196 2197 2198/* 2199 * Return 1 if the given type is a single-bit boolean set, 2200 * in which the domain's min and max values 2201 * are both zero, 2202 * 0 if not. This can become a macro later.. 2203 */ 2204int 2205ch_singleton_set (type) 2206 tree type; 2207{ 2208 if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK) 2209 return 0; 2210 if (TREE_CODE (type) != SET_TYPE) 2211 return 0; 2212 if (TREE_TYPE (type) == NULL_TREE 2213 || TREE_CODE (TREE_TYPE (type)) != BOOLEAN_TYPE) 2214 return 0; 2215 if (TYPE_DOMAIN (type) == NULL_TREE) 2216 return 0; 2217 if (! tree_int_cst_equal (TYPE_MIN_VALUE (TYPE_DOMAIN (type)), 2218 integer_zero_node)) 2219 return 0; 2220 if (! tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (type)), 2221 integer_zero_node)) 2222 return 0; 2223 return 1; 2224} 2225 2226/* return non-zero if TYPE is a compiler-generated VARYING 2227 array of some base type */ 2228int 2229chill_varying_type_p (type) 2230 tree type; 2231{ 2232 if (type == NULL_TREE) 2233 return 0; 2234 if (TREE_CODE (type) != RECORD_TYPE) 2235 return 0; 2236 if (TYPE_FIELDS (type) == NULL_TREE 2237 || TREE_CHAIN (TYPE_FIELDS (type)) == NULL_TREE) 2238 return 0; 2239 if (DECL_NAME (TYPE_FIELDS (type)) != var_length_id) 2240 return 0; 2241 if (DECL_NAME (TREE_CHAIN (TYPE_FIELDS (type))) != var_data_id) 2242 return 0; 2243 if (TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (type))) != NULL_TREE) 2244 return 0; 2245 return 1; 2246} 2247 2248/* return non-zero if TYPE is a compiler-generated VARYING 2249 string record */ 2250int 2251chill_varying_string_type_p (type) 2252 tree type; 2253{ 2254 tree var_data_type; 2255 2256 if (!chill_varying_type_p (type)) 2257 return 0; 2258 2259 var_data_type = CH_VARYING_ARRAY_TYPE (type); 2260 return CH_CHARS_TYPE_P (var_data_type); 2261} 2262 2263/* swiped from c-typeck.c */ 2264/* Build an assignment expression of lvalue LHS from value RHS. */ 2265 2266tree 2267build_chill_modify_expr (lhs, rhs) 2268 tree lhs, rhs; 2269{ 2270 register tree result; 2271 2272 2273 tree lhstype = TREE_TYPE (lhs); 2274 2275 /* Avoid duplicate error messages from operands that had errors. */ 2276 if (lhs == NULL_TREE || TREE_CODE (lhs) == ERROR_MARK || rhs == NULL_TREE || TREE_CODE (rhs) == ERROR_MARK) 2277 return error_mark_node; 2278 2279 /* Strip NON_LVALUE_EXPRs since we aren't using as an lvalue. */ 2280 /* Do not use STRIP_NOPS here. We do not want an enumerator 2281 whose value is 0 to count as a null pointer constant. */ 2282 if (TREE_CODE (rhs) == NON_LVALUE_EXPR) 2283 rhs = TREE_OPERAND (rhs, 0); 2284 2285#if 0 2286 /* Handle a cast used as an "lvalue". 2287 We have already performed any binary operator using the value as cast. 2288 Now convert the result to the cast type of the lhs, 2289 and then true type of the lhs and store it there; 2290 then convert result back to the cast type to be the value 2291 of the assignment. */ 2292 2293 switch (TREE_CODE (lhs)) 2294 { 2295 case NOP_EXPR: 2296 case CONVERT_EXPR: 2297 case FLOAT_EXPR: 2298 case FIX_TRUNC_EXPR: 2299 case FIX_FLOOR_EXPR: 2300 case FIX_ROUND_EXPR: 2301 case FIX_CEIL_EXPR: 2302 { 2303 tree inner_lhs = TREE_OPERAND (lhs, 0); 2304 tree result; 2305 result = build_chill_modify_expr (inner_lhs, 2306 convert (TREE_TYPE (inner_lhs), 2307 convert (lhstype, rhs))); 2308 pedantic_lvalue_warning (CONVERT_EXPR); 2309 return convert (TREE_TYPE (lhs), result); 2310 } 2311 } 2312 2313 /* Now we have handled acceptable kinds of LHS that are not truly lvalues. 2314 Reject anything strange now. */ 2315 2316 if (!lvalue_or_else (lhs, "assignment")) 2317 return error_mark_node; 2318#endif 2319 /* FIXME: need to generate a RANGEFAIL if the RHS won't 2320 fit into the LHS. */ 2321 2322 if (TREE_CODE (lhs) != VAR_DECL 2323 && ((TREE_CODE (TREE_TYPE (lhs)) == ARRAY_TYPE && 2324 (TREE_TYPE (rhs) && TREE_CODE (TREE_TYPE (rhs)) == ARRAY_TYPE)) || 2325 chill_varying_type_p (TREE_TYPE (lhs)) || 2326 chill_varying_type_p (TREE_TYPE (rhs)))) 2327 { 2328 int lhs_varying = chill_varying_type_p (TREE_TYPE (lhs)); 2329 int rhs_varying = chill_varying_type_p (TREE_TYPE (rhs)); 2330 2331 /* point at actual RHS data's type */ 2332 tree rhs_data_type = rhs_varying ? 2333 CH_VARYING_ARRAY_TYPE (TREE_TYPE (rhs)) : 2334 TREE_TYPE (rhs); 2335 { 2336 /* point at actual LHS data's type */ 2337 tree lhs_data_type = lhs_varying ? 2338 CH_VARYING_ARRAY_TYPE (TREE_TYPE (lhs)) : 2339 TREE_TYPE (lhs); 2340 2341 int lhs_bytes = int_size_in_bytes (lhs_data_type); 2342 int rhs_bytes = int_size_in_bytes (rhs_data_type); 2343 2344 /* if both sides not varying, and sizes not dynamically 2345 computed, sizes must *match* */ 2346 if (! lhs_varying && ! rhs_varying && lhs_bytes != rhs_bytes 2347 && lhs_bytes > 0 && rhs_bytes > 0) 2348 { 2349 error ("string lengths not equal"); 2350 return error_mark_node; 2351 } 2352 /* Must have enough space on LHS for static size of RHS */ 2353 2354 if (lhs_bytes > 0 && rhs_bytes > 0 2355 && lhs_bytes < rhs_bytes) 2356 { 2357 if (rhs_varying) 2358 { 2359 /* FIXME: generate runtime test for room */ 2360 ; 2361 } 2362 else 2363 { 2364 error ("can't do ARRAY assignment - too large"); 2365 return error_mark_node; 2366 } 2367 } 2368 } 2369 2370 /* now we know the RHS will fit in LHS, build trees for the 2371 emit_block_move parameters */ 2372 2373 if (lhs_varying) 2374 rhs = convert (TREE_TYPE (lhs), rhs); 2375 else 2376 { 2377 if (rhs_varying) 2378 rhs = build_component_ref (rhs, var_data_id); 2379 2380 if (! mark_addressable (rhs)) 2381 { 2382 error ("rhs of array assignment is not addressable"); 2383 return error_mark_node; 2384 } 2385 2386 lhs = force_addr_of (lhs); 2387 rhs = build1 (ADDR_EXPR, const_ptr_type_node, rhs); 2388 return 2389 build_chill_function_call (lookup_name (get_identifier ("memmove")), 2390 tree_cons (NULL_TREE, lhs, 2391 tree_cons (NULL_TREE, rhs, 2392 tree_cons (NULL_TREE, size_in_bytes (rhs_data_type), 2393 NULL_TREE)))); 2394 } 2395 } 2396 2397 result = build (MODIFY_EXPR, lhstype, lhs, rhs); 2398 TREE_SIDE_EFFECTS (result) = 1; 2399 2400 return result; 2401} 2402 2403/* Constructors for pointer, array and function types. 2404 (RECORD_TYPE, UNION_TYPE and ENUMERAL_TYPE nodes are 2405 constructed by language-dependent code, not here.) */ 2406 2407/* Construct, lay out and return the type of pointers to TO_TYPE. 2408 If such a type has already been constructed, reuse it. */ 2409 2410tree 2411make_chill_pointer_type (to_type, code) 2412 tree to_type; 2413 enum tree_code code; /* POINTER_TYPE or REFERENCE_TYPE */ 2414{ 2415 extern struct obstack *current_obstack; 2416 extern struct obstack *saveable_obstack; 2417 extern struct obstack permanent_obstack; 2418 tree t; 2419 register struct obstack *ambient_obstack = current_obstack; 2420 register struct obstack *ambient_saveable_obstack = saveable_obstack; 2421 2422 /* If TO_TYPE is permanent, make this permanent too. */ 2423 if (TREE_PERMANENT (to_type)) 2424 { 2425 current_obstack = &permanent_obstack; 2426 saveable_obstack = &permanent_obstack; 2427 } 2428 2429 t = make_node (code); 2430 TREE_TYPE (t) = to_type; 2431 2432 current_obstack = ambient_obstack; 2433 saveable_obstack = ambient_saveable_obstack; 2434 return t; 2435} 2436 2437 2438tree 2439build_chill_pointer_type (to_type) 2440 tree to_type; 2441{ 2442 int is_type_node = TREE_CODE_CLASS (TREE_CODE (to_type)) == 't'; 2443 register tree t = is_type_node ? TYPE_POINTER_TO (to_type) : NULL_TREE; 2444 2445 /* First, if we already have a type for pointers to TO_TYPE, use it. */ 2446 2447 if (t) 2448 return t; 2449 2450 /* We need a new one. */ 2451 t = make_chill_pointer_type (to_type, POINTER_TYPE); 2452 2453 /* Lay out the type. This function has many callers that are concerned 2454 with expression-construction, and this simplifies them all. 2455 Also, it guarantees the TYPE_SIZE is permanent if the type is. */ 2456 if ((is_type_node && (TYPE_SIZE (to_type) != NULL_TREE)) 2457 || pass == 2) 2458 { 2459 /* Record this type as the pointer to TO_TYPE. */ 2460 TYPE_POINTER_TO (to_type) = t; 2461 layout_type (t); 2462 } 2463 2464 return t; 2465} 2466 2467tree 2468build_chill_reference_type (to_type) 2469 tree to_type; 2470{ 2471 int is_type_node = TREE_CODE_CLASS (TREE_CODE (to_type)) == 't'; 2472 register tree t = is_type_node ? TYPE_REFERENCE_TO (to_type) : NULL_TREE; 2473 2474 /* First, if we already have a type for references to TO_TYPE, use it. */ 2475 2476 if (t) 2477 return t; 2478 2479 /* We need a new one. */ 2480 t = make_chill_pointer_type (to_type, REFERENCE_TYPE); 2481 2482 /* Lay out the type. This function has many callers that are concerned 2483 with expression-construction, and this simplifies them all. 2484 Also, it guarantees the TYPE_SIZE is permanent if the type is. */ 2485 if ((is_type_node && (TYPE_SIZE (to_type) != NULL_TREE)) 2486 || pass == 2) 2487 { 2488 /* Record this type as the reference to TO_TYPE. */ 2489 TYPE_REFERENCE_TO (to_type) = t; 2490 layout_type (t); 2491 CH_NOVELTY (t) = CH_NOVELTY (to_type); 2492 } 2493 2494 return t; 2495} 2496 2497tree 2498make_chill_range_type (type, lowval, highval) 2499 tree type, lowval, highval; 2500{ 2501 register tree itype = make_node (INTEGER_TYPE); 2502 TREE_TYPE (itype) = type; 2503 TYPE_MIN_VALUE (itype) = lowval; 2504 TYPE_MAX_VALUE (itype) = highval; 2505 return itype; 2506} 2507 2508tree 2509layout_chill_range_type (rangetype, must_be_const) 2510 tree rangetype; 2511 int must_be_const; 2512{ 2513 tree type = TREE_TYPE (rangetype); 2514 tree lowval = TYPE_MIN_VALUE (rangetype); 2515 tree highval = TYPE_MAX_VALUE (rangetype); 2516 int bad_limits = 0; 2517 2518 if (TYPE_SIZE (rangetype) != NULL_TREE) 2519 return rangetype; 2520 2521 /* process BIN */ 2522 if (type == ridpointers[(int) RID_BIN]) 2523 { 2524 int binsize; 2525 2526 /* make a range out of it */ 2527 if (TREE_CODE (highval) != INTEGER_CST) 2528 { 2529 error ("non-constant expression for BIN"); 2530 return error_mark_node; 2531 } 2532 binsize = TREE_INT_CST_LOW (highval); 2533 if (binsize < 0) 2534 { 2535 error ("expression for BIN must not be negative"); 2536 return error_mark_node; 2537 } 2538 if (binsize > 32) 2539 { 2540 error ("cannot process BIN (>32)"); 2541 return error_mark_node; 2542 } 2543 type = ridpointers [(int) RID_RANGE]; 2544 lowval = integer_zero_node; 2545 highval = build_int_2 ((1 << binsize) - 1, 0); 2546 } 2547 2548 if (TREE_CODE (lowval) == ERROR_MARK || 2549 TREE_CODE (highval) == ERROR_MARK) 2550 return error_mark_node; 2551 2552 if (!CH_COMPATIBLE_CLASSES (lowval, highval)) 2553 { 2554 error ("bounds of range are not compatible"); 2555 return error_mark_node; 2556 } 2557 2558 if (type == string_index_type_dummy) 2559 { 2560 if (TREE_CODE (highval) == INTEGER_CST 2561 && compare_int_csts (LT_EXPR, highval, integer_minus_one_node)) 2562 { 2563 error ("negative string length"); 2564 highval = integer_minus_one_node; 2565 } 2566 if (compare_int_csts (EQ_EXPR, highval, integer_minus_one_node)) 2567 type = integer_type_node; 2568 else 2569 type = sizetype; 2570 TREE_TYPE (rangetype) = type; 2571 } 2572 else if (type == ridpointers[(int) RID_RANGE]) 2573 { 2574 /* This isn't 100% right, since the Blue Book definition 2575 uses Resulting Class, rather than Resulting Mode, 2576 but it's close enough. */ 2577 type = CH_ROOT_RESULTING_CLASS (lowval, highval).mode; 2578 2579 /* The default TYPE is the type of the constants - 2580 except if the constants are integers, we choose an 2581 integer type that fits. */ 2582 if (TREE_CODE (type) == INTEGER_TYPE 2583 && TREE_CODE (lowval) == INTEGER_CST 2584 && TREE_CODE (highval) == INTEGER_CST) 2585 { 2586 /* The logic of this code has been copied from finish_enum 2587 in c-decl.c. FIXME duplication! */ 2588 int precision = 0; 2589 HOST_WIDE_INT maxvalue = TREE_INT_CST_LOW (highval); 2590 HOST_WIDE_INT minvalue = TREE_INT_CST_LOW (lowval); 2591 if (TREE_INT_CST_HIGH (lowval) >= 0 2592 ? tree_int_cst_lt (TYPE_MAX_VALUE (unsigned_type_node), highval) 2593 : (tree_int_cst_lt (lowval, TYPE_MIN_VALUE (integer_type_node)) 2594 || tree_int_cst_lt (TYPE_MAX_VALUE (integer_type_node), highval))) 2595 precision = TYPE_PRECISION (long_long_integer_type_node); 2596 else 2597 { 2598 if (maxvalue > 0) 2599 precision = floor_log2 (maxvalue) + 1; 2600 if (minvalue < 0) 2601 { 2602 /* Compute number of bits to represent magnitude of a 2603 negative value. Add one to MINVALUE since range of 2604 negative numbers includes the power of two. */ 2605 int negprecision = floor_log2 (-minvalue - 1) + 1; 2606 if (negprecision > precision) 2607 precision = negprecision; 2608 precision += 1; /* room for sign bit */ 2609 } 2610 2611 if (!precision) 2612 precision = 1; 2613 } 2614 type = type_for_size (precision, minvalue >= 0); 2615 2616 } 2617 TREE_TYPE (rangetype) = type; 2618 } 2619 else 2620 { 2621 if (!CH_COMPATIBLE (lowval, type)) 2622 { 2623 error ("range's lower bound and parent mode don't match"); 2624 return integer_type_node; /* an innocuous fake */ 2625 } 2626 if (!CH_COMPATIBLE (highval, type)) 2627 { 2628 error ("range's upper bound and parent mode don't match"); 2629 return integer_type_node; /* an innocuous fake */ 2630 } 2631 } 2632 2633 if (TREE_CODE (type) == ERROR_MARK) 2634 return type; 2635 else if (TREE_CODE_CLASS (TREE_CODE (type)) != 't') 2636 { 2637 error ("making range from non-mode"); 2638 return error_mark_node; 2639 } 2640 2641 if (TREE_CODE (lowval) == REAL_CST || TREE_CODE (highval) == REAL_CST) 2642 { 2643 sorry ("floating point ranges"); 2644 return integer_type_node; /* another fake */ 2645 } 2646 2647 if (TREE_CODE (lowval) != INTEGER_CST || TREE_CODE (highval) != INTEGER_CST) 2648 { 2649 if (must_be_const) 2650 { 2651 error ("range mode has non-constant limits"); 2652 bad_limits = 1; 2653 } 2654 } 2655 else if (tree_int_cst_equal (lowval, integer_zero_node) 2656 && tree_int_cst_equal (highval, integer_minus_one_node)) 2657 ; /* do nothing - this is the index type for an empty string */ 2658 else if (compare_int_csts (LT_EXPR, highval, TYPE_MIN_VALUE (type))) 2659 { 2660 error ("range's high bound < mode's low bound"); 2661 bad_limits = 1; 2662 } 2663 else if (compare_int_csts (GT_EXPR, highval, TYPE_MAX_VALUE (type))) 2664 { 2665 error ("range's high bound > mode's high bound"); 2666 bad_limits = 1; 2667 } 2668 else if (compare_int_csts (LT_EXPR, highval, lowval)) 2669 { 2670 error ("range mode high bound < range mode low bound"); 2671 bad_limits = 1; 2672 } 2673 else if (compare_int_csts (LT_EXPR, lowval, TYPE_MIN_VALUE (type))) 2674 { 2675 error ("range's low bound < mode's low bound"); 2676 bad_limits = 1; 2677 } 2678 else if (compare_int_csts (GT_EXPR, lowval, TYPE_MAX_VALUE (type))) 2679 { 2680 error ("range's low bound > mode's high bound"); 2681 bad_limits = 1; 2682 } 2683 2684 if (bad_limits) 2685 { 2686 lowval = TYPE_MIN_VALUE (type); 2687 highval = lowval; 2688 } 2689 2690 highval = convert (type, highval); 2691 lowval = convert (type, lowval); 2692 TYPE_MIN_VALUE (rangetype) = lowval; 2693 TYPE_MAX_VALUE (rangetype) = highval; 2694 TYPE_PRECISION (rangetype) = TYPE_PRECISION (type); 2695 TYPE_MODE (rangetype) = TYPE_MODE (type); 2696 TYPE_SIZE (rangetype) = TYPE_SIZE (type); 2697 TYPE_SIZE_UNIT (rangetype) = TYPE_SIZE_UNIT (type); 2698 TYPE_ALIGN (rangetype) = TYPE_ALIGN (type); 2699 TREE_UNSIGNED (rangetype) = TREE_UNSIGNED (type); 2700 CH_NOVELTY (rangetype) = CH_NOVELTY (type); 2701 return rangetype; 2702} 2703 2704/* Build a _TYPE node that has range bounds associated with its values. 2705 TYPE is the base type for the range type. */ 2706tree 2707build_chill_range_type (type, lowval, highval) 2708 tree type, lowval, highval; 2709{ 2710 tree rangetype; 2711 2712 if (type == NULL_TREE) 2713 type = ridpointers[(int) RID_RANGE]; 2714 else if (TREE_CODE (type) == ERROR_MARK) 2715 return error_mark_node; 2716 2717 rangetype = make_chill_range_type (type, lowval, highval); 2718 if (pass != 1) 2719 rangetype = layout_chill_range_type (rangetype, 0); 2720 2721 return rangetype; 2722} 2723 2724/* Build a CHILL array type, but with minimal checking etc. */ 2725 2726tree 2727build_simple_array_type (type, idx, layout) 2728 tree type, idx, layout; 2729{ 2730 tree array_type = make_node (ARRAY_TYPE); 2731 TREE_TYPE (array_type) = type; 2732 TYPE_DOMAIN (array_type) = idx; 2733 TYPE_ATTRIBUTES (array_type) = layout; 2734 if (pass != 1) 2735 array_type = layout_chill_array_type (array_type); 2736 return array_type; 2737} 2738 2739static void 2740apply_chill_array_layout (array_type) 2741 tree array_type; 2742{ 2743 tree layout, temp, what, element_type; 2744 int stepsize=0, word, start_bit=0, length, natural_length; 2745 int stepsize_specified; 2746 int start_bit_error = 0; 2747 int length_error = 0; 2748 2749 layout = TYPE_ATTRIBUTES (array_type); 2750 if (layout == NULL_TREE) 2751 return; 2752 2753 if (layout == integer_zero_node) /* NOPACK */ 2754 { 2755 TYPE_PACKED (array_type) = 0; 2756 return; 2757 } 2758 2759 /* Allow for the packing of 1 bit discrete modes at the bit level. */ 2760 element_type = TREE_TYPE (array_type); 2761 if (discrete_type_p (element_type) 2762 && get_type_precision (TYPE_MIN_VALUE (element_type), 2763 TYPE_MAX_VALUE (element_type)) == 1) 2764 natural_length = 1; 2765 else 2766 natural_length = TREE_INT_CST_LOW (TYPE_SIZE (element_type)); 2767 2768 if (layout == integer_one_node) /* PACK */ 2769 { 2770 if (natural_length == 1) 2771 TYPE_PACKED (array_type) = 1; 2772 return; 2773 } 2774 2775 /* The layout is a STEP (...). 2776 The current implementation restricts STEP specifications to be of the form 2777 STEP(POS(0,0,n),n) where n is the natural size of the element mode. */ 2778 stepsize_specified = 0; 2779 temp = TREE_VALUE (layout); 2780 if (TREE_VALUE (temp) != NULL_TREE) 2781 { 2782 if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST) 2783 error ("Stepsize in STEP must be an integer constant"); 2784 else 2785 { 2786 stepsize = TREE_INT_CST_LOW (TREE_VALUE (temp)); 2787 if (stepsize <= 0) 2788 error ("Stepsize in STEP must be > 0"); 2789 else 2790 stepsize_specified = 1; 2791 2792 if (stepsize != natural_length) 2793 sorry ("Stepsize in STEP must be the natural width of " 2794 "the array element mode"); 2795 } 2796 } 2797 2798 temp = TREE_PURPOSE (temp); 2799 if (TREE_CODE (TREE_PURPOSE (temp)) != INTEGER_CST) 2800 error ("Starting word in POS must be an integer constant"); 2801 else 2802 { 2803 word = TREE_INT_CST_LOW (TREE_PURPOSE (temp)); 2804 if (word < 0) 2805 error ("Starting word in POS must be >= 0"); 2806 if (word != 0) 2807 sorry ("Starting word in POS within STEP must be 0"); 2808 } 2809 2810 length = natural_length; 2811 temp = TREE_VALUE (temp); 2812 if (temp != NULL_TREE) 2813 { 2814 int wordsize = TYPE_PRECISION (chill_integer_type_node); 2815 if (TREE_CODE (TREE_PURPOSE (temp)) != INTEGER_CST) 2816 { 2817 error ("Starting bit in POS must be an integer constant"); 2818 start_bit_error = 1; 2819 } 2820 else 2821 { 2822 start_bit = TREE_INT_CST_LOW (TREE_PURPOSE (temp)); 2823 if (start_bit != 0) 2824 sorry ("Starting bit in POS within STEP must be 0"); 2825 if (start_bit < 0) 2826 { 2827 error ("Starting bit in POS must be >= 0"); 2828 start_bit = 0; 2829 start_bit_error = 1; 2830 } 2831 else if (start_bit >= wordsize) 2832 { 2833 error ("Starting bit in POS must be < the width of a word"); 2834 start_bit = 0; 2835 start_bit_error = 1; 2836 } 2837 } 2838 2839 temp = TREE_VALUE (temp); 2840 if (temp != NULL_TREE) 2841 { 2842 what = TREE_PURPOSE (temp); 2843 if (what == integer_zero_node) 2844 { 2845 if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST) 2846 { 2847 error ("Length in POS must be an integer constant"); 2848 length_error = 1; 2849 } 2850 else 2851 { 2852 length = TREE_INT_CST_LOW (TREE_VALUE (temp)); 2853 if (length <= 0) 2854 error ("Length in POS must be > 0"); 2855 } 2856 } 2857 else 2858 { 2859 if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST) 2860 { 2861 error ("End bit in POS must be an integer constant"); 2862 length_error = 1; 2863 } 2864 else 2865 { 2866 int end_bit = TREE_INT_CST_LOW (TREE_VALUE (temp)); 2867 if (end_bit < start_bit) 2868 { 2869 error ("End bit in POS must be >= the start bit"); 2870 end_bit = wordsize - 1; 2871 length_error = 1; 2872 } 2873 else if (end_bit >= wordsize) 2874 { 2875 error ("End bit in POS must be < the width of a word"); 2876 end_bit = wordsize - 1; 2877 length_error = 1; 2878 } 2879 else if (start_bit_error) 2880 length_error = 1; 2881 else 2882 length = end_bit - start_bit + 1; 2883 } 2884 } 2885 if (! length_error && length != natural_length) 2886 { 2887 sorry ("The length specified on POS within STEP must be " 2888 "the natural length of the array element type"); 2889 } 2890 } 2891 } 2892 2893 if (! length_error && stepsize_specified && stepsize < length) 2894 error ("Step size in STEP must be >= the length in POS"); 2895 2896 if (length == 1) 2897 TYPE_PACKED (array_type) = 1; 2898} 2899 2900tree 2901layout_chill_array_type (array_type) 2902 tree array_type; 2903{ 2904 tree itype; 2905 tree element_type = TREE_TYPE (array_type); 2906 2907 if (TREE_CODE (element_type) == ARRAY_TYPE 2908 && TYPE_SIZE (element_type) == 0) 2909 layout_chill_array_type (element_type); 2910 2911 itype = TYPE_DOMAIN (array_type); 2912 2913 if (TREE_CODE (itype) == ERROR_MARK 2914 || TREE_CODE (element_type) == ERROR_MARK) 2915 return error_mark_node; 2916 2917 /* do a lower/upper bound check. */ 2918 if (TREE_CODE (itype) == INTEGER_CST) 2919 { 2920 error ("array index must be a range, not a single integer"); 2921 return error_mark_node; 2922 } 2923 if (TREE_CODE_CLASS (TREE_CODE (itype)) != 't' 2924 || !discrete_type_p (itype)) 2925 { 2926 error ("array index is not a discrete mode"); 2927 return error_mark_node; 2928 } 2929 2930 /* apply the array layout, if specified. */ 2931 apply_chill_array_layout (array_type); 2932 TYPE_ATTRIBUTES (array_type) = NULL_TREE; 2933 2934 /* Make sure TYPE_POINTER_TO (element_type) is filled in. */ 2935 build_pointer_type (element_type); 2936 2937 if (TYPE_SIZE (array_type) == 0) 2938 layout_type (array_type); 2939 2940 if (TYPE_READONLY_PROPERTY (element_type)) 2941 TYPE_FIELDS_READONLY (array_type) = 1; 2942 2943 TYPE_ARRAY_MAX_SIZE (array_type) = size_in_bytes (array_type); 2944 return array_type; 2945} 2946 2947/* Build a CHILL array type. 2948 2949 TYPE is the element type of the array. 2950 IDXLIST is the list of dimensions of the array. 2951 VARYING_P is non-zero if the array is a varying array. 2952 LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list), 2953 meaning (default, pack, nopack, STEP (...) ). */ 2954tree 2955build_chill_array_type (type, idxlist, varying_p, layouts) 2956 tree type, idxlist; 2957 int varying_p; 2958 tree layouts; 2959{ 2960 tree array_type = type; 2961 2962 if (type == NULL_TREE || TREE_CODE (type) == ERROR_MARK) 2963 return error_mark_node; 2964 if (idxlist == NULL_TREE || TREE_CODE (idxlist) == ERROR_MARK) 2965 return error_mark_node; 2966 2967 /* We have to walk down the list of index decls, building inner 2968 array types as we go. We need to reverse the list of layouts so that the 2969 first layout applies to the last index etc. */ 2970 layouts = nreverse (layouts); 2971 for ( ; idxlist; idxlist = TREE_CHAIN (idxlist)) 2972 { 2973 if (layouts != NULL_TREE) 2974 { 2975 type = build_simple_array_type ( 2976 type, TREE_VALUE (idxlist), TREE_VALUE (layouts)); 2977 layouts = TREE_CHAIN (layouts); 2978 } 2979 else 2980 type = build_simple_array_type (type, TREE_VALUE (idxlist), NULL_TREE); 2981 } 2982 array_type = type; 2983 if (varying_p) 2984 array_type = build_varying_struct (array_type); 2985 return array_type; 2986} 2987 2988/* Function to help qsort sort FIELD_DECLs by name order. */ 2989 2990static int 2991field_decl_cmp (x, y) 2992 tree *x, *y; 2993{ 2994 return (long)DECL_NAME (*x) - (long)DECL_NAME (*y); 2995} 2996 2997tree 2998make_chill_struct_type (fieldlist) 2999 tree fieldlist; 3000{ 3001 tree t, x; 3002 if (TREE_UNION_ELEM (fieldlist)) 3003 t = make_node (UNION_TYPE); 3004 else 3005 t = make_node (RECORD_TYPE); 3006 /* Install struct as DECL_CONTEXT of each field decl. */ 3007 for (x = fieldlist; x; x = TREE_CHAIN (x)) 3008 { 3009 DECL_CONTEXT (x) = t; 3010 DECL_FIELD_SIZE (x) = 0; 3011 } 3012 3013 /* Delete all duplicate fields from the fieldlist */ 3014 for (x = fieldlist; x && TREE_CHAIN (x);) 3015 /* Anonymous fields aren't duplicates. */ 3016 if (DECL_NAME (TREE_CHAIN (x)) == 0) 3017 x = TREE_CHAIN (x); 3018 else 3019 { 3020 register tree y = fieldlist; 3021 3022 while (1) 3023 { 3024 if (DECL_NAME (y) == DECL_NAME (TREE_CHAIN (x))) 3025 break; 3026 if (y == x) 3027 break; 3028 y = TREE_CHAIN (y); 3029 } 3030 if (DECL_NAME (y) == DECL_NAME (TREE_CHAIN (x))) 3031 { 3032 error_with_decl (TREE_CHAIN (x), "duplicate member `%s'"); 3033 TREE_CHAIN (x) = TREE_CHAIN (TREE_CHAIN (x)); 3034 } 3035 else x = TREE_CHAIN (x); 3036 } 3037 3038 TYPE_FIELDS (t) = fieldlist; 3039 3040 return t; 3041} 3042 3043/* decl is a FIELD_DECL. 3044 DECL_INIT (decl) is (NULL_TREE, integer_one_node, integer_zero_node, tree_list), 3045 meaning (default, pack, nopack, POS (...) ). 3046 The return value is a boolean: 1 if POS specified, 0 if not */ 3047static int 3048apply_chill_field_layout (decl, next_struct_offset) 3049 tree decl; 3050 int* next_struct_offset; 3051{ 3052 tree layout, type, temp, what; 3053 int word = 0, wordsize, start_bit, offset, length, natural_length; 3054 int pos_error = 0; 3055 int is_discrete; 3056 3057 type = TREE_TYPE (decl); 3058 is_discrete = discrete_type_p (type); 3059 if (is_discrete) 3060 natural_length = get_type_precision (TYPE_MIN_VALUE (type), TYPE_MAX_VALUE (type)); 3061 else 3062 natural_length = TREE_INT_CST_LOW (TYPE_SIZE (type)); 3063 3064 layout = DECL_INITIAL (decl); 3065 if (layout == integer_zero_node) /* NOPACK */ 3066 { 3067 DECL_PACKED (decl) = 0; 3068 *next_struct_offset += natural_length; 3069 return 0; /* not POS */ 3070 } 3071 3072 if (layout == integer_one_node) /* PACK */ 3073 { 3074 if (is_discrete) 3075 DECL_BIT_FIELD (decl) = 1; 3076 else 3077 { 3078 DECL_BIT_FIELD (decl) = 0; 3079 DECL_ALIGN (decl) = BITS_PER_UNIT; 3080 } 3081 DECL_PACKED (decl) = 1; 3082 DECL_FIELD_SIZE (decl) = natural_length; 3083 *next_struct_offset += natural_length; 3084 return 0; /* not POS */ 3085 } 3086 3087 /* The layout is a POS (...). The current implementation restricts the use 3088 of POS to monotonically increasing fields whose width must be the 3089 natural width of the underlying type. */ 3090 temp = TREE_PURPOSE (layout); 3091 3092 if (TREE_CODE (TREE_PURPOSE (temp)) != INTEGER_CST) 3093 { 3094 error ("Starting word in POS must be an integer constant"); 3095 pos_error = 1; 3096 } 3097 else 3098 { 3099 word = TREE_INT_CST_LOW (TREE_PURPOSE (temp)); 3100 if (word < 0) 3101 { 3102 error ("Starting word in POS must be >= 0"); 3103 word = 0; 3104 pos_error = 1; 3105 } 3106 } 3107 3108 wordsize = TYPE_PRECISION (chill_integer_type_node); 3109 offset = word * wordsize; 3110 length = natural_length; 3111 3112 temp = TREE_VALUE (temp); 3113 if (temp != NULL_TREE) 3114 { 3115 if (TREE_CODE (TREE_PURPOSE (temp)) != INTEGER_CST) 3116 { 3117 error ("Starting bit in POS must be an integer constant"); 3118 start_bit = *next_struct_offset - offset; 3119 pos_error = 1; 3120 } 3121 else 3122 { 3123 start_bit = TREE_INT_CST_LOW (TREE_PURPOSE (temp)); 3124 if (start_bit < 0) 3125 { 3126 error ("Starting bit in POS must be >= 0"); 3127 start_bit = *next_struct_offset - offset; 3128 pos_error = 1; 3129 } 3130 else if (start_bit >= wordsize) 3131 { 3132 error ("Starting bit in POS must be < the width of a word"); 3133 start_bit = *next_struct_offset - offset; 3134 pos_error = 1; 3135 } 3136 } 3137 3138 temp = TREE_VALUE (temp); 3139 if (temp != NULL_TREE) 3140 { 3141 what = TREE_PURPOSE (temp); 3142 if (what == integer_zero_node) 3143 { 3144 if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST) 3145 { 3146 error ("Length in POS must be an integer constant"); 3147 pos_error = 1; 3148 } 3149 else 3150 { 3151 length = TREE_INT_CST_LOW (TREE_VALUE (temp)); 3152 if (length <= 0) 3153 { 3154 error ("Length in POS must be > 0"); 3155 length = natural_length; 3156 pos_error = 1; 3157 } 3158 } 3159 } 3160 else 3161 { 3162 if (TREE_CODE (TREE_VALUE (temp)) != INTEGER_CST) 3163 { 3164 error ("End bit in POS must be an integer constant"); 3165 pos_error = 1; 3166 } 3167 else 3168 { 3169 int end_bit = TREE_INT_CST_LOW (TREE_VALUE (temp)); 3170 if (end_bit < start_bit) 3171 { 3172 error ("End bit in POS must be >= the start bit"); 3173 pos_error = 1; 3174 } 3175 else if (end_bit >= wordsize) 3176 { 3177 error ("End bit in POS must be < the width of a word"); 3178 pos_error = 1; 3179 } 3180 else 3181 length = end_bit - start_bit + 1; 3182 } 3183 } 3184 if (length != natural_length && ! pos_error) 3185 { 3186 sorry ("The length specified on POS must be the natural length " 3187 "of the field type"); 3188 length = natural_length; 3189 } 3190 } 3191 3192 offset += start_bit; 3193 } 3194 3195 if (offset != *next_struct_offset && ! pos_error) 3196 sorry ("STRUCT fields must be layed out in monotonically increasing order"); 3197 3198 DECL_PACKED (decl) = 1; 3199 DECL_BIT_FIELD (decl) = is_discrete; 3200 DECL_FIELD_SIZE (decl) = length; 3201 *next_struct_offset += natural_length; 3202 3203 return 1; /* was POS */ 3204} 3205 3206tree 3207layout_chill_struct_type (t) 3208 tree t; 3209{ 3210 tree fieldlist = TYPE_FIELDS (t); 3211 tree x; 3212 int old_momentary; 3213 int was_pos; 3214 int pos_seen = 0; 3215 int pos_error = 0; 3216 int next_struct_offset; 3217 3218 old_momentary = suspend_momentary (); 3219 3220 /* Process specified field sizes. 3221 Set DECL_FIELD_SIZE to the specified size, or 0 if none specified. 3222 The specified size is found in the DECL_INITIAL. 3223 Store 0 there, except for ": 0" fields (so we can find them 3224 and delete them, below). */ 3225 3226 next_struct_offset = 0; 3227 for (x = fieldlist; x; x = TREE_CHAIN (x)) 3228 { 3229 /* An EVENT or BUFFER mode is implemented as a RECORD_TYPE 3230 which may contain a CONST_DECL for the maximum queue size. */ 3231 if (TREE_CODE (x) == CONST_DECL) 3232 continue; 3233 3234 /* If any field is const, the structure type is pseudo-const. */ 3235 /* A field that is pseudo-const makes the structure likewise. */ 3236 if (TREE_READONLY (x) || TYPE_READONLY_PROPERTY (TREE_TYPE (x))) 3237 TYPE_FIELDS_READONLY (t) = 1; 3238 3239 /* Any field that is volatile means variables of this type must be 3240 treated in some ways as volatile. */ 3241 if (TREE_THIS_VOLATILE (x)) 3242 C_TYPE_FIELDS_VOLATILE (t) = 1; 3243 3244 if (DECL_INITIAL (x) != NULL_TREE) 3245 { 3246 was_pos = apply_chill_field_layout (x, &next_struct_offset); 3247 DECL_INITIAL (x) = NULL_TREE; 3248 } 3249 else 3250 { 3251 unsigned int min_align = TYPE_ALIGN (TREE_TYPE (x)); 3252 DECL_ALIGN (x) = MAX (DECL_ALIGN (x), min_align); 3253 was_pos = 0; 3254 } 3255 if ((! was_pos && pos_seen) || (was_pos && ! pos_seen && x != fieldlist)) 3256 pos_error = 1; 3257 pos_seen |= was_pos; 3258 } 3259 3260 if (pos_error) 3261 error ("If one field has a POS layout, then all fields must have a POS layout"); 3262 3263 /* Now DECL_INITIAL is null on all fields. */ 3264 3265 layout_type (t); 3266 3267 /* Now we have the truly final field list. 3268 Store it in this type and in the variants. */ 3269 3270 TYPE_FIELDS (t) = fieldlist; 3271 3272 /* If there are lots of fields, sort so we can look through them fast. 3273 We arbitrarily consider 16 or more elts to be "a lot". */ 3274 { 3275 int len = 0; 3276 3277 for (x = fieldlist; x; x = TREE_CHAIN (x)) 3278 { 3279 if (len > 15) 3280 break; 3281 len += 1; 3282 } 3283 if (len > 15) 3284 { 3285 tree *field_array; 3286 char *space; 3287 3288 len += list_length (x); 3289 /* Use the same allocation policy here that make_node uses, to 3290 ensure that this lives as long as the rest of the struct decl. 3291 All decls in an inline function need to be saved. */ 3292 if (allocation_temporary_p ()) 3293 space = savealloc (sizeof (struct lang_type) + len * sizeof (tree)); 3294 else 3295 space = oballoc (sizeof (struct lang_type) + len * sizeof (tree)); 3296 3297 TYPE_LANG_SPECIFIC (t) = (struct lang_type *) space; 3298 TYPE_LANG_SPECIFIC (t)->foo.rec.len = len; 3299 3300 field_array = &TYPE_LANG_SPECIFIC (t)->foo.rec.elts[0]; 3301 len = 0; 3302 for (x = fieldlist; x; x = TREE_CHAIN (x)) 3303 field_array[len++] = x; 3304 3305 qsort (field_array, len, sizeof (tree), field_decl_cmp); 3306 } 3307 } 3308 3309 for (x = TYPE_MAIN_VARIANT (t); x; x = TYPE_NEXT_VARIANT (x)) 3310 { 3311 TYPE_FIELDS (x) = TYPE_FIELDS (t); 3312 TYPE_LANG_SPECIFIC (x) = TYPE_LANG_SPECIFIC (t); 3313 TYPE_ALIGN (x) = TYPE_ALIGN (t); 3314 } 3315 3316 resume_momentary (old_momentary); 3317 3318 return t; 3319} 3320 3321/* Given a list of fields, FIELDLIST, return a structure 3322 type that contains these fields. The returned type is 3323 always a new type. */ 3324tree 3325build_chill_struct_type (fieldlist) 3326 tree fieldlist; 3327{ 3328 register tree t; 3329 3330 if (fieldlist == NULL_TREE || TREE_CODE (fieldlist) == ERROR_MARK) 3331 return error_mark_node; 3332 3333 t = make_chill_struct_type (fieldlist); 3334 if (pass != 1) 3335 t = layout_chill_struct_type (t); 3336 3337/* pushtag (NULL_TREE, t); */ 3338 3339 return t; 3340} 3341 3342/* Fix a LANG_TYPE. These are used for three different uses: 3343 - representing a 'READ M' (in which case TYPE_READONLY is set); 3344 - for a NEWMODE or SYNMODE (CH_NOVELTY is set for a NEWMODE); and 3345 - for a parameterised type (TREE_TYPE points to base type, 3346 while TYPE_DOMAIN is the parameter or parameter list). 3347 Called from satisfy. */ 3348tree 3349smash_dummy_type (type) 3350 tree type; 3351{ 3352 /* Save fields that we don't want to copy from ORIGIN. */ 3353 tree origin = TREE_TYPE (type); 3354 tree main_tree = TYPE_MAIN_VARIANT (origin); 3355 int save_uid = TYPE_UID (type); 3356 struct obstack *save_obstack = TYPE_OBSTACK (type); 3357 tree save_name = TYPE_NAME (type); 3358 int save_permanent = TREE_PERMANENT (type); 3359 int save_readonly = TYPE_READONLY (type); 3360 tree save_novelty = CH_NOVELTY (type); 3361 tree save_domain = TYPE_DOMAIN (type); 3362 3363 if (origin == NULL_TREE) 3364 abort (); 3365 3366 if (save_domain) 3367 { 3368 if (TREE_CODE (save_domain) == ERROR_MARK) 3369 return error_mark_node; 3370 if (origin == char_type_node) 3371 { /* Old-fashioned CHAR(N) declaration. */ 3372 origin = build_string_type (origin, save_domain); 3373 } 3374 else 3375 { /* Handle parameterised modes. */ 3376 int is_varying = chill_varying_type_p (origin); 3377 tree new_max = save_domain; 3378 tree origin_novelty = CH_NOVELTY (origin); 3379 if (is_varying) 3380 origin = CH_VARYING_ARRAY_TYPE (origin); 3381 if (CH_STRING_TYPE_P (origin)) 3382 { 3383 tree oldindex = TYPE_DOMAIN (origin); 3384 new_max = check_range (new_max, new_max, NULL_TREE, 3385 size_binop (PLUS_EXPR, 3386 TYPE_MAX_VALUE (oldindex), 3387 integer_one_node)); 3388 origin = build_string_type (TREE_TYPE (origin), new_max); 3389 } 3390 else if (TREE_CODE (origin) == ARRAY_TYPE) 3391 { 3392 tree oldindex = TYPE_DOMAIN (origin); 3393 tree upper = check_range (new_max, new_max, NULL_TREE, 3394 TYPE_MAX_VALUE (oldindex)); 3395 tree newindex 3396 = build_chill_range_type (TREE_TYPE (oldindex), 3397 TYPE_MIN_VALUE (oldindex), upper); 3398 origin = build_simple_array_type (TREE_TYPE (origin), newindex, NULL_TREE); 3399 } 3400 else if (TREE_CODE (origin) == RECORD_TYPE) 3401 { 3402 error ("parameterised structures not implemented"); 3403 return error_mark_node; 3404 } 3405 else 3406 { 3407 error ("invalid parameterised type"); 3408 return error_mark_node; 3409 } 3410 3411 SET_CH_NOVELTY (origin, origin_novelty); 3412 if (is_varying) 3413 { 3414 origin = build_varying_struct (origin); 3415 SET_CH_NOVELTY (origin, origin_novelty); 3416 } 3417 } 3418 save_domain = NULL_TREE; 3419 } 3420 3421 if (TREE_CODE (origin) == ERROR_MARK) 3422 return error_mark_node; 3423 3424 *(struct tree_type*)type = *(struct tree_type*)origin; 3425 /* The following is so that the debug code for 3426 the copy is different from the original type. 3427 The two statements usually duplicate each other 3428 (because they clear fields of the same union), 3429 but the optimizer should catch that. */ 3430 TYPE_SYMTAB_POINTER (type) = 0; 3431 TYPE_SYMTAB_ADDRESS (type) = 0; 3432 3433 /* Restore fields that we didn't want copied from ORIGIN. */ 3434 TYPE_UID (type) = save_uid; 3435 TYPE_OBSTACK (type) = save_obstack; 3436 TREE_PERMANENT (type) = save_permanent; 3437 TYPE_NAME (type) = save_name; 3438 3439 TREE_CHAIN (type) = NULL_TREE; 3440 TYPE_VOLATILE (type) = 0; 3441 TYPE_POINTER_TO (type) = 0; 3442 TYPE_REFERENCE_TO (type) = 0; 3443 3444 if (save_readonly) 3445 { /* TYPE is READ ORIGIN. 3446 Add this type to the chain of variants of TYPE. */ 3447 TYPE_NEXT_VARIANT (type) = TYPE_NEXT_VARIANT (main_tree); 3448 TYPE_NEXT_VARIANT (main_tree) = type; 3449 TYPE_READONLY (type) = save_readonly; 3450 } 3451 else 3452 { 3453 /* TYPE is the copy of the RHS in a NEWMODE or SYNMODE. 3454 We also get here after old-fashioned CHAR(N) declaration (see above). */ 3455 TYPE_MAIN_VARIANT (type) = type; 3456 TYPE_NEXT_VARIANT (type) = NULL_TREE; 3457 if (save_name) 3458 DECL_ORIGINAL_TYPE (save_name) = origin; 3459 3460 if (save_novelty != NULL_TREE) /* A NEWMODE declaration. */ 3461 { 3462 CH_NOVELTY (type) = save_novelty; 3463 3464 /* Z.200: "If the DEFINING mode of the NEWMODE name is a range mode, 3465 then the virtual mode &name is introduced as the PARENT mode 3466 of the NEWMODE name. The DEFINING mode of &name is the PARENT 3467 mode of the range mode, and the NOVELTY of &name is that of 3468 the NEWMODE name." */ 3469 3470 if (TREE_CODE (type) == INTEGER_TYPE && TREE_TYPE (type)) 3471 { 3472 tree parent; 3473 /* PARENT is the virtual mode &name mentioned above. */ 3474 push_obstacks_nochange (); 3475 end_temporary_allocation (); 3476 parent = copy_novelty (save_novelty,TREE_TYPE (type)); 3477 pop_obstacks (); 3478 3479 TREE_TYPE (type) = parent; 3480 TYPE_MIN_VALUE (type) = convert (parent, TYPE_MIN_VALUE (type)); 3481 TYPE_MAX_VALUE (type) = convert (parent, TYPE_MAX_VALUE (type)); 3482 } 3483 } 3484 } 3485 return type; 3486} 3487 3488/* This generates a LANG_TYPE node that represents 'READ TYPE'. */ 3489 3490tree 3491build_readonly_type (type) 3492 tree type; 3493{ 3494 tree node = make_node (LANG_TYPE); 3495 TREE_TYPE (node) = type; 3496 TYPE_READONLY (node) = 1; 3497 if (pass != 1) 3498 node = smash_dummy_type (node); 3499 return node; 3500} 3501 3502 3503/* Return an unsigned type the same as TYPE in other respects. */ 3504 3505tree 3506unsigned_type (type) 3507 tree type; 3508{ 3509 tree type1 = TYPE_MAIN_VARIANT (type); 3510 if (type1 == signed_char_type_node || type1 == char_type_node) 3511 return unsigned_char_type_node; 3512 if (type1 == integer_type_node) 3513 return unsigned_type_node; 3514 if (type1 == short_integer_type_node) 3515 return short_unsigned_type_node; 3516 if (type1 == long_integer_type_node) 3517 return long_unsigned_type_node; 3518 if (type1 == long_long_integer_type_node) 3519 return long_long_unsigned_type_node; 3520 3521 return signed_or_unsigned_type (1, type); 3522} 3523 3524/* Return a signed type the same as TYPE in other respects. */ 3525 3526tree 3527signed_type (type) 3528 tree type; 3529{ 3530 tree type1 = TYPE_MAIN_VARIANT (type); 3531 while (TREE_CODE (type1) == INTEGER_TYPE && TREE_TYPE (type1) != NULL_TREE) 3532 type1 = TREE_TYPE (type1); 3533 if (type1 == unsigned_char_type_node || type1 == char_type_node) 3534 return signed_char_type_node; 3535 if (type1 == unsigned_type_node) 3536 return integer_type_node; 3537 if (type1 == short_unsigned_type_node) 3538 return short_integer_type_node; 3539 if (type1 == long_unsigned_type_node) 3540 return long_integer_type_node; 3541 if (type1 == long_long_unsigned_type_node) 3542 return long_long_integer_type_node; 3543 if (TYPE_PRECISION (type1) == 1) 3544 return signed_boolean_type_node; 3545 3546 return signed_or_unsigned_type (0, type); 3547} 3548 3549/* Return a type the same as TYPE except unsigned or 3550 signed according to UNSIGNEDP. */ 3551 3552tree 3553signed_or_unsigned_type (unsignedp, type) 3554 int unsignedp; 3555 tree type; 3556{ 3557 if (! INTEGRAL_TYPE_P (type) 3558 || TREE_UNSIGNED (type) == unsignedp) 3559 return type; 3560 3561 if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node)) 3562 return unsignedp ? unsigned_char_type_node : signed_char_type_node; 3563 if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node)) 3564 return unsignedp ? unsigned_type_node : integer_type_node; 3565 if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node)) 3566 return unsignedp ? short_unsigned_type_node : short_integer_type_node; 3567 if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node)) 3568 return unsignedp ? long_unsigned_type_node : long_integer_type_node; 3569 if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node)) 3570 return (unsignedp ? long_long_unsigned_type_node 3571 : long_long_integer_type_node); 3572 return type; 3573} 3574 3575/* Mark EXP saying that we need to be able to take the 3576 address of it; it should not be allocated in a register. 3577 Value is 1 if successful. */ 3578 3579int 3580mark_addressable (exp) 3581 tree exp; 3582{ 3583 register tree x = exp; 3584 while (1) 3585 switch (TREE_CODE (x)) 3586 { 3587 case ADDR_EXPR: 3588 case COMPONENT_REF: 3589 case ARRAY_REF: 3590 case REALPART_EXPR: 3591 case IMAGPART_EXPR: 3592 x = TREE_OPERAND (x, 0); 3593 break; 3594 3595 case TRUTH_ANDIF_EXPR: 3596 case TRUTH_ORIF_EXPR: 3597 case COMPOUND_EXPR: 3598 x = TREE_OPERAND (x, 1); 3599 break; 3600 3601 case COND_EXPR: 3602 return mark_addressable (TREE_OPERAND (x, 1)) 3603 & mark_addressable (TREE_OPERAND (x, 2)); 3604 3605 case CONSTRUCTOR: 3606 TREE_ADDRESSABLE (x) = 1; 3607 return 1; 3608 3609 case INDIRECT_REF: 3610 /* We sometimes add a cast *(TYPE*)&FOO to handle type and mode 3611 incompatibility problems. Handle this case by marking FOO. */ 3612 if (TREE_CODE (TREE_OPERAND (x, 0)) == NOP_EXPR 3613 && TREE_CODE (TREE_OPERAND (TREE_OPERAND (x, 0), 0)) == ADDR_EXPR) 3614 { 3615 x = TREE_OPERAND (TREE_OPERAND (x, 0), 0); 3616 break; 3617 } 3618 if (TREE_CODE (TREE_OPERAND (x, 0)) == ADDR_EXPR) 3619 { 3620 x = TREE_OPERAND (x, 0); 3621 break; 3622 } 3623 return 1; 3624 3625 case VAR_DECL: 3626 case CONST_DECL: 3627 case PARM_DECL: 3628 case RESULT_DECL: 3629 if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x) 3630 && DECL_NONLOCAL (x)) 3631 { 3632 if (TREE_PUBLIC (x)) 3633 { 3634 error ("global register variable `%s' used in nested function", 3635 IDENTIFIER_POINTER (DECL_NAME (x))); 3636 return 0; 3637 } 3638 pedwarn ("register variable `%s' used in nested function", 3639 IDENTIFIER_POINTER (DECL_NAME (x))); 3640 } 3641 else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)) 3642 { 3643 if (TREE_PUBLIC (x)) 3644 { 3645 error ("address of global register variable `%s' requested", 3646 IDENTIFIER_POINTER (DECL_NAME (x))); 3647 return 0; 3648 } 3649 3650 /* If we are making this addressable due to its having 3651 volatile components, give a different error message. Also 3652 handle the case of an unnamed parameter by not trying 3653 to give the name. */ 3654 3655 else if (C_TYPE_FIELDS_VOLATILE (TREE_TYPE (x))) 3656 { 3657 error ("cannot put object with volatile field into register"); 3658 return 0; 3659 } 3660 3661 pedwarn ("address of register variable `%s' requested", 3662 IDENTIFIER_POINTER (DECL_NAME (x))); 3663 } 3664 put_var_into_stack (x); 3665 3666 /* drops through */ 3667 case FUNCTION_DECL: 3668 TREE_ADDRESSABLE (x) = 1; 3669#if 0 /* poplevel deals with this now. */ 3670 if (DECL_CONTEXT (x) == 0) 3671 TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x)) = 1; 3672#endif 3673 /* drops through */ 3674 default: 3675 return 1; 3676 } 3677} 3678 3679/* Return nonzero if VALUE is a valid constant-valued expression 3680 for use in initializing a static variable; one that can be an 3681 element of a "constant" initializer. 3682 3683 Return null_pointer_node if the value is absolute; 3684 if it is relocatable, return the variable that determines the relocation. 3685 We assume that VALUE has been folded as much as possible; 3686 therefore, we do not need to check for such things as 3687 arithmetic-combinations of integers. */ 3688 3689tree 3690initializer_constant_valid_p (value, endtype) 3691 tree value; 3692 tree endtype; 3693{ 3694 switch (TREE_CODE (value)) 3695 { 3696 case CONSTRUCTOR: 3697 if (TREE_CODE (TREE_TYPE (value)) == UNION_TYPE 3698 && TREE_CONSTANT (value)) 3699 return 3700 initializer_constant_valid_p (TREE_VALUE (CONSTRUCTOR_ELTS (value)), 3701 endtype); 3702 3703 return TREE_STATIC (value) ? null_pointer_node : 0; 3704 3705 case INTEGER_CST: 3706 case REAL_CST: 3707 case STRING_CST: 3708 case COMPLEX_CST: 3709 return null_pointer_node; 3710 3711 case ADDR_EXPR: 3712 return TREE_OPERAND (value, 0); 3713 3714 case NON_LVALUE_EXPR: 3715 return initializer_constant_valid_p (TREE_OPERAND (value, 0), endtype); 3716 3717 case CONVERT_EXPR: 3718 case NOP_EXPR: 3719 /* Allow conversions between pointer types. */ 3720 if (TREE_CODE (TREE_TYPE (value)) == POINTER_TYPE 3721 && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == POINTER_TYPE) 3722 return initializer_constant_valid_p (TREE_OPERAND (value, 0), endtype); 3723 3724 /* Allow conversions between real types. */ 3725 if (TREE_CODE (TREE_TYPE (value)) == REAL_TYPE 3726 && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == REAL_TYPE) 3727 return initializer_constant_valid_p (TREE_OPERAND (value, 0), endtype); 3728 3729 /* Allow length-preserving conversions between integer types. */ 3730 if (TREE_CODE (TREE_TYPE (value)) == INTEGER_TYPE 3731 && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == INTEGER_TYPE 3732 && (TYPE_PRECISION (TREE_TYPE (value)) 3733 == TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (value, 0))))) 3734 return initializer_constant_valid_p (TREE_OPERAND (value, 0), endtype); 3735 3736 /* Allow conversions between other integer types only if 3737 explicit value. */ 3738 if (TREE_CODE (TREE_TYPE (value)) == INTEGER_TYPE 3739 && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == INTEGER_TYPE) 3740 { 3741 tree inner = initializer_constant_valid_p (TREE_OPERAND (value, 0), 3742 endtype); 3743 if (inner == null_pointer_node) 3744 return null_pointer_node; 3745 return 0; 3746 } 3747 3748 /* Allow (int) &foo provided int is as wide as a pointer. */ 3749 if (TREE_CODE (TREE_TYPE (value)) == INTEGER_TYPE 3750 && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == POINTER_TYPE 3751 && (TYPE_PRECISION (TREE_TYPE (value)) 3752 >= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (value, 0))))) 3753 return initializer_constant_valid_p (TREE_OPERAND (value, 0), 3754 endtype); 3755 3756 /* Likewise conversions from int to pointers. */ 3757 if (TREE_CODE (TREE_TYPE (value)) == POINTER_TYPE 3758 && TREE_CODE (TREE_TYPE (TREE_OPERAND (value, 0))) == INTEGER_TYPE 3759 && (TYPE_PRECISION (TREE_TYPE (value)) 3760 <= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (value, 0))))) 3761 return initializer_constant_valid_p (TREE_OPERAND (value, 0), 3762 endtype); 3763 3764 /* Allow conversions to union types if the value inside is okay. */ 3765 if (TREE_CODE (TREE_TYPE (value)) == UNION_TYPE) 3766 return initializer_constant_valid_p (TREE_OPERAND (value, 0), 3767 endtype); 3768 return 0; 3769 3770 case PLUS_EXPR: 3771 if (TREE_CODE (endtype) == INTEGER_TYPE 3772 && TYPE_PRECISION (endtype) < POINTER_SIZE) 3773 return 0; 3774 { 3775 tree valid0 = initializer_constant_valid_p (TREE_OPERAND (value, 0), 3776 endtype); 3777 tree valid1 = initializer_constant_valid_p (TREE_OPERAND (value, 1), 3778 endtype); 3779 /* If either term is absolute, use the other terms relocation. */ 3780 if (valid0 == null_pointer_node) 3781 return valid1; 3782 if (valid1 == null_pointer_node) 3783 return valid0; 3784 return 0; 3785 } 3786 3787 case MINUS_EXPR: 3788 if (TREE_CODE (endtype) == INTEGER_TYPE 3789 && TYPE_PRECISION (endtype) < POINTER_SIZE) 3790 return 0; 3791 { 3792 tree valid0 = initializer_constant_valid_p (TREE_OPERAND (value, 0), 3793 endtype); 3794 tree valid1 = initializer_constant_valid_p (TREE_OPERAND (value, 1), 3795 endtype); 3796 /* Win if second argument is absolute. */ 3797 if (valid1 == null_pointer_node) 3798 return valid0; 3799 /* Win if both arguments have the same relocation. 3800 Then the value is absolute. */ 3801 if (valid0 == valid1) 3802 return null_pointer_node; 3803 return 0; 3804 } 3805 default: 3806 return 0; 3807 } 3808} 3809 3810/* Return an integer type with BITS bits of precision, 3811 that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */ 3812 3813tree 3814type_for_size (bits, unsignedp) 3815 unsigned bits; 3816 int unsignedp; 3817{ 3818 if (bits == TYPE_PRECISION (integer_type_node)) 3819 return unsignedp ? unsigned_type_node : integer_type_node; 3820 3821 if (bits == TYPE_PRECISION (signed_char_type_node)) 3822 return unsignedp ? unsigned_char_type_node : signed_char_type_node; 3823 3824 if (bits == TYPE_PRECISION (short_integer_type_node)) 3825 return unsignedp ? short_unsigned_type_node : short_integer_type_node; 3826 3827 if (bits == TYPE_PRECISION (long_integer_type_node)) 3828 return unsignedp ? long_unsigned_type_node : long_integer_type_node; 3829 3830 if (bits == TYPE_PRECISION (long_long_integer_type_node)) 3831 return (unsignedp ? long_long_unsigned_type_node 3832 : long_long_integer_type_node); 3833 3834 if (bits <= TYPE_PRECISION (intQI_type_node)) 3835 return unsignedp ? unsigned_intQI_type_node : intQI_type_node; 3836 3837 if (bits <= TYPE_PRECISION (intHI_type_node)) 3838 return unsignedp ? unsigned_intHI_type_node : intHI_type_node; 3839 3840 if (bits <= TYPE_PRECISION (intSI_type_node)) 3841 return unsignedp ? unsigned_intSI_type_node : intSI_type_node; 3842 3843 if (bits <= TYPE_PRECISION (intDI_type_node)) 3844 return unsignedp ? unsigned_intDI_type_node : intDI_type_node; 3845 3846#if HOST_BITS_PER_WIDE_INT >= 64 3847 if (bits <= TYPE_PRECISION (intTI_type_node)) 3848 return unsignedp ? unsigned_intTI_type_node : intTI_type_node; 3849#endif 3850 3851 return 0; 3852} 3853 3854/* Return a data type that has machine mode MODE. 3855 If the mode is an integer, 3856 then UNSIGNEDP selects between signed and unsigned types. */ 3857 3858tree 3859type_for_mode (mode, unsignedp) 3860 enum machine_mode mode; 3861 int unsignedp; 3862{ 3863 if ((int)mode == (int)TYPE_MODE (integer_type_node)) 3864 return unsignedp ? unsigned_type_node : integer_type_node; 3865 3866 if ((int)mode == (int)TYPE_MODE (signed_char_type_node)) 3867 return unsignedp ? unsigned_char_type_node : signed_char_type_node; 3868 3869 if ((int)mode == (int)TYPE_MODE (short_integer_type_node)) 3870 return unsignedp ? short_unsigned_type_node : short_integer_type_node; 3871 3872 if ((int)mode == (int)TYPE_MODE (long_integer_type_node)) 3873 return unsignedp ? long_unsigned_type_node : long_integer_type_node; 3874 3875 if ((int)mode == (int)TYPE_MODE (long_long_integer_type_node)) 3876 return unsignedp ? long_long_unsigned_type_node : long_long_integer_type_node; 3877 3878 if ((int)mode == (int)TYPE_MODE (intQI_type_node)) 3879 return unsignedp ? unsigned_intQI_type_node : intQI_type_node; 3880 3881 if ((int)mode == (int)TYPE_MODE (intHI_type_node)) 3882 return unsignedp ? unsigned_intHI_type_node : intHI_type_node; 3883 3884 if ((int)mode == (int)TYPE_MODE (intSI_type_node)) 3885 return unsignedp ? unsigned_intSI_type_node : intSI_type_node; 3886 3887 if ((int)mode == (int)TYPE_MODE (intDI_type_node)) 3888 return unsignedp ? unsigned_intDI_type_node : intDI_type_node; 3889 3890#if HOST_BITS_PER_WIDE_INT >= 64 3891 if ((int)mode == (int)TYPE_MODE (intTI_type_node)) 3892 return unsignedp ? unsigned_intTI_type_node : intTI_type_node; 3893#endif 3894 3895 if ((int)mode == (int)TYPE_MODE (float_type_node)) 3896 return float_type_node; 3897 3898 if ((int)mode == (int)TYPE_MODE (double_type_node)) 3899 return double_type_node; 3900 3901 if ((int)mode == (int)TYPE_MODE (long_double_type_node)) 3902 return long_double_type_node; 3903 3904 if ((int)mode == (int)TYPE_MODE (build_pointer_type (char_type_node))) 3905 return build_pointer_type (char_type_node); 3906 3907 if ((int)mode == (int)TYPE_MODE (build_pointer_type (integer_type_node))) 3908 return build_pointer_type (integer_type_node); 3909 3910 return 0; 3911} 3912