| blob | 68bb09ed4e9d947e6e01a976c54d7f9c7cb9315e |
1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * T R A N S *
6 * *
7 * C Implementation File *
8 * *
9 * *
10 * Copyright (C) 1992-2002, Free Software Foundation, Inc. *
11 * *
12 * GNAT is free software; you can redistribute it and/or modify it under *
13 * terms of the GNU General Public License as published by the Free Soft- *
14 * ware Foundation; either version 2, or (at your option) any later ver- *
15 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
16 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
17 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
18 * for more details. You should have received a copy of the GNU General *
19 * Public License distributed with GNAT; see file COPYING. If not, write *
20 * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
21 * MA 02111-1307, USA. *
22 * *
23 * GNAT was originally developed by the GNAT team at New York University. *
24 * Extensive contributions were provided by Ada Core Technologies Inc. *
25 * *
26 ****************************************************************************/
69 /* Current filename without path. */
72 /* Flag indicating whether file names are discarded in exception messages */
75 /* If true, then gigi is being called on an analyzed but unexpanded
76 tree, and the only purpose of the call is to properly annotate
77 types with representation information. */
80 /* List of TREE_LIST nodes representing a block stack. TREE_VALUE
81 of each gives the variable used for the setjmp buffer in the current
82 block, if any. TREE_PURPOSE gives the bottom condition for a loop,
83 if this block is for a loop. The latter is only used to save the tree
84 over GC. */
85 tree gnu_block_stack;
87 /* List of TREE_LIST nodes representing a stack of exception pointer
88 variables. TREE_VALUE is the VAR_DECL that stores the address of
89 the raised exception. Nonzero means we are in an exception
90 handler. Not used in the zero-cost case. */
93 /* List of TREE_LIST nodes containing pending elaborations lists.
94 used to prevent the elaborations being reclaimed by GC. */
97 /* Map GNAT tree codes to GCC tree codes for simple expressions. */
100 /* Current node being treated, in case gigi_abort called. */
101 Node_Id error_gnat_node;
103 /* Variable that stores a list of labels to be used as a goto target instead of
104 a return in some functions. See processing for N_Subprogram_Body. */
128 /* Constants for +0.5 and -0.5 for float-to-integer rounding. */
131 \f
132 /* This is the main program of the back-end. It sets up all the table
133 structures and then generates code. */
135 void
140 Node_Id gnat_root;
151 Int number_units ATTRIBUTE_UNUSED;
153 Entity_Id standard_integer;
154 Entity_Id standard_long_long_float;
155 Entity_Id standard_exception_type;
156 Int gigi_operating_mode;
157 {
158 tree gnu_standard_long_long_float;
159 tree gnu_standard_exception_type;
174 /* See if we should discard file names in exception messages. */
182 /* Initialize ourselves. */
187 /* Enable GNAT stack checking method if needed */
191 /* Save the type we made for integer as the type for Standard.Integer.
192 Then make the rest of the standard types. Note that some of these
193 may be subtypes. */
202 gnu_standard_long_long_float
204 gnu_standard_exception_type
209 /* Process any Pragma Ident for the main unit. */
210 #ifdef ASM_OUTPUT_IDENT
212 ASM_OUTPUT_IDENT
215 #endif
217 /* If we are using the GCC exception mechanism, let GCC know. */
222 }
224 \f
225 /* This function is the driver of the GNAT to GCC tree transformation process.
226 GNAT_NODE is the root of some gnat tree. It generates code for that
227 part of the tree. */
229 void
231 Node_Id gnat_node;
232 {
233 tree gnu_root;
235 /* Save node number in case error */
240 /* This should just generate code, not return a value. If it returns
241 a value, something is wrong. */
244 }
246 /* GNAT_NODE is the root of some GNAT tree. Return the root of the GCC
247 tree corresponding to that GNAT tree. Normally, no code is generated.
248 We just return an equivalent tree which is used elsewhere to generate
249 code. */
251 tree
253 Node_Id gnat_node;
254 {
255 tree gnu_root;
257 /* Save node number in case error */
262 /* If we got no code as a result, something is wrong. */
267 }
268 \f
269 /* This function is the driver of the GNAT to GCC tree transformation process.
270 It is the entry point of the tree transformer. GNAT_NODE is the root of
271 some GNAT tree. Return the root of the corresponding GCC tree or
272 error_mark_node to signal that there is no GCC tree to return.
274 The latter is the case if only code generation actions have to be performed
275 like in the case of if statements, loops, etc. This routine is wrapped
276 in the above two routines for most purposes. */
278 static tree
280 Node_Id gnat_node;
281 {
284 tree gnu_expr;
286 Node_Id gnat_temp;
287 Entity_Id gnat_temp_type;
289 /* Set input_file_name and lineno from the Sloc in the GNAT tree. */
292 /* If this is a Statement and we are at top level, we add the statement
293 as an elaboration for a null tree. That will cause it to be placed
294 in the elaboration procedure. */
307 {
311 }
313 /* If this node is a non-static subexpression and we are only
314 annotating types, make this into a NULL_EXPR for non-VOID types
315 and error_mark_node for void return types. But allow
316 N_Identifier since we use it for lots of things, including
317 getting trees for discriminants. */
323 {
328 else
331 }
334 {
335 /********************************/
336 /* Chapter 2: Lexical Elements: */
337 /********************************/
344 /* If the Etype of this node does not equal the Etype of the
345 Entity, something is wrong with the entity map, probably in
346 generic instantiation. However, this does not apply to
347 types. Since we sometime have strange Ekind's, just do
348 this test for objects. Also, if the Etype of the Entity
349 is private, the Etype of the N_Identifier is allowed to be the
350 full type and also we consider a packed array type to be the
351 same as the original type. Finally, if the types are Itypes,
352 one may be a copy of the other, which is also legal. */
375 /* If this is a reference to a deferred constant whose partial view
376 is an unconstrained private type, the proper type is on the full
377 view of the constant, not on the full view of the type, which may
378 be unconstrained.
380 This may be a reference to a type, for example in the prefix of the
381 attribute Position, generated for dispatching code (see Make_DT in
382 exp_disp,adb). In that case we need the type itself, not is parent,
383 in particular if it is a derived type */
389 {
393 }
394 else
395 {
396 /* Expand the type of this identitier first, in case it is
397 an enumeral literal, which only get made when the type
398 is expanded. There is no order-of-elaboration issue here.
399 We want to use the Actual_Subtype if it has already been
400 elaborated, otherwise the Etype. Avoid using Actual_Subtype
401 for packed arrays to simplify things. */
409 else
413 }
417 /* If we are in an exception handler, force this variable into memory
418 to ensure optimization does not remove stores that appear
419 redundant but are actually needed in case an exception occurs.
421 ??? Note that we need not do this if the variable is declared within
422 the handler, only if it is referenced in the handler and declared
423 in an enclosing block, but we have no way of testing that
424 right now. */
426 {
429 }
431 /* Some objects (such as parameters passed by reference, globals of
432 variable size, and renamed objects) actually represent the address
433 of the object. In that case, we must do the dereference. Likewise,
434 deal with parameters to foreign convention subprograms. Call fold
435 here since GNU_RESULT may be a CONST_DECL. */
439 {
444 gnu_result);
449 }
451 /* The GNAT tree has the type of a function as the type of its result.
452 Also use the type of the result if the Etype is a subtype which
453 is nominally unconstrained. But remove any padding from the
454 resulting type. */
457 {
462 }
464 /* We always want to return the underlying INTEGER_CST for an
465 enumeration literal to avoid the need to call fold in lots
466 of places. But don't do this is the parent will be taking
467 the address of this object. */
469 {
483 }
487 {
488 tree gnu_type;
490 /* Get the type of the result, looking inside any padding and
491 left-justified modular types. Then get the value in that type. */
500 /* If the result overflows (meaning it doesn't fit in its base type),
501 abort. We would like to check that the value is within the range
502 of the subtype, but that causes problems with subtypes whose usage
503 will raise Constraint_Error and with biased representation, so
504 we don't. */
507 }
511 /* If a Entity is present, it means that this was one of the
512 literals in a user-defined character type. In that case,
513 just return the value in the CONST_DECL. Otherwise, use the
514 character code. In that case, the base type should be an
515 INTEGER_TYPE, but we won't bother checking for that. */
519 else
525 /* If this is of a fixed-point type, the value we want is the
526 value of the corresponding integer. */
528 {
531 gnu_result_type);
533 #if 0
539 gnu_result))
540 #endif
541 )
543 }
544 /* We should never see a Vax_Float type literal, since the front end
545 is supposed to transform these using appropriate conversions */
549 else
550 {
555 /* If the real value is zero, so is the result. Otherwise,
556 convert it to a machine number if it isn't already. That
557 forces BASE to 0 or 2 and simplifies the rest of our logic. */
560 else
561 {
563 ur_realval
567 gnu_result
570 /* If we have a base of zero, divide by the denominator.
571 Otherwise, the base must be 2 and we scale the value, which
572 we know can fit in the mantissa of the type (hence the use
573 of that type above). */
575 gnu_result
578 gnu_result,
580 gnu_result_type));
584 else
585 {
586 REAL_VALUE_TYPE tmp;
591 }
592 }
594 /* Now see if we need to negate the result. Do it this way to
595 properly handle -0. */
597 gnu_result
599 gnu_result);
600 }
607 {
608 /* We assume here that all strings are of type standard.string.
609 "Weird" types of string have been converted to an aggregate
610 by the expander. */
616 /* Build the string with the characters in the literal. Note
617 that Ada strings are 1-origin. */
621 /* Put a null at the end of the string in case it's in a context
622 where GCC will want to treat it as a C string. */
627 /* Strings in GCC don't normally have types, but we want
628 this to not be converted to the array type. */
630 }
631 else
632 {
633 /* Build a list consisting of each character, then make
634 the aggregate. */
641 gnu_list
647 gnu_list);
649 gnu_result
651 }
658 /* Check for (and ignore) unrecognized pragma */
663 {
665 /* Do nothing at top level: all such variables are already
666 viewable. */
674 {
682 }
688 {
702 }
709 }
712 /**************************************/
713 /* Chapter 3: Declarations and Types: */
714 /**************************************/
729 /* If we are just annotating types and this object has an unconstrained
730 or task type, don't elaborate it. */
741 && (! type_annotate_only
743 {
748 /* If this object has its elaboration delayed, we must force
749 evaluation of GNU_EXPR right now and save it for when the object
750 is frozen. */
752 {
755 gnu_expr
759 else
763 }
764 }
765 else
780 /* Don't do anything if this renaming is handled by the front end.
781 or if we are just annotating types and this object has a
782 composite or task type, don't elaborate it. */
784 && ! (type_annotate_only
788 {
791 }
802 /* These are fully handled in the front end. */
805 /*************************************/
806 /* Chapter 4: Names and Expressions: */
807 /*************************************/
813 /* Emit access check if necessary */
821 {
823 tree gnu_type;
828 /* Emit access check if necessary */
835 /* If we got a padded type, remove it too. */
838 gnu_array_object
840 gnu_array_object);
844 /* First compute the number of dimensions of the array, then
845 fill the expression array, the order depending on whether
846 this is a Convention_Fortran array or not. */
851 ;
860 else
868 {
876 gnu_expr
877 = emit_index_check
884 }
885 }
891 {
892 tree gnu_type;
898 /* Emit access check if necessary */
902 /* Do any implicit dereferences of the prefix and do any needed
903 range check. */
908 {
909 /* Get the bounds of the slice. */
910 tree gnu_index_type
916 /* Check to see that the minimum slice value is in range */
917 gnu_expr_l
918 = emit_index_check
923 /* Check to see that the maximum slice value is in range */
924 gnu_expr_h
925 = emit_index_check
930 /* Derive a good type to convert everything too */
933 /* Build a compound expression that does the range checks */
934 gnu_expr
939 /* Build a conditional expression that returns the range checks
940 expression if the slice range is not null (max >= min) or
941 returns the min if the slice range is null */
942 gnu_expr
946 gnu_max_expr),
948 gnu_min_expr)),
950 }
951 else
956 }
960 {
964 tree gnu_field;
968 {
973 }
980 /* For discriminant references in tagged types always substitute the
981 corresponding discriminant as the actual selected component. */
987 /* For discriminant references of untagged types always substitute the
988 corresponding girder discriminant. */
993 /* Handle extracting the real or imaginary part of a complex.
994 The real part is the first field and the imaginary the last. */
1000 else
1001 {
1004 /* If there are discriminants, the prefix might be
1005 evaluated more than once, which is a problem if it has
1006 side-effects. */
1013 /* Emit discriminant check if necessary. */
1016 gnu_result
1018 }
1024 }
1028 {
1029 /* The attribute designator (like an enumeration value). */
1032 tree gnu_prefix;
1033 tree gnu_type;
1035 /* The Elab_Spec and Elab_Body attributes are special in that
1036 Prefix is a unit, not an object with a GCC equivalent. Similarly
1037 for Elaborated, since that variable isn't otherwise known. */
1039 {
1040 gnu_prefix
1041 = create_subprog_decl
1043 attribute == Attr_Elab_Body
1047 }
1052 /* If the input is a NULL_EXPR, make a new one. */
1054 {
1059 }
1062 {
1065 /* These are just conversions until since representation
1066 clauses for enumerations are handled in the front end. */
1067 {
1074 }
1079 /* These just add or subject the constant 1. Representation
1080 clauses for enumerations are handled in the front-end. */
1085 {
1087 gnu_expr
1088 = emit_check
1090 gnu_expr,
1091 attribute == Attr_Pred
1095 }
1097 gnu_result
1107 /* Conversions don't change something's address but can cause
1108 us to miss the COMPONENT_REF case below, so strip them off. */
1109 gnu_prefix
1113 /* If we are taking 'Address of an unconstrained object,
1114 this is the pointer to the underlying array. */
1117 /* ... fall through ... */
1124 gnu_result
1131 /* For 'Code_Address, find an inner ADDR_EXPR and mark it
1132 so that we don't try to build a trampoline. */
1134 {
1140 ;
1144 }
1155 /* Remove NOPS from gnu_expr and conversions from gnu_prefix.
1156 We only use GNU_EXPR to see if a COMPONENT_REF was involved. */
1164 /* Replace an unconstrained array type with the type of the
1165 underlying array. We can't do this with a call to
1166 maybe_unconstrained_array since we may have a TYPE_DECL.
1167 For 'Max_Size_In_Storage_Elements, use the record type
1168 that will be used to allocate the object and its template. */
1171 {
1175 }
1177 /* If we are looking for the size of a field, return the
1178 field size. Otherwise, if the prefix is an object,
1179 or if 'Object_Size or 'Max_Size_In_Storage_Elements has
1180 been specified, the result is the GCC size of the type.
1181 Otherwise, the result is the RM_Size of the type. */
1187 {
1188 /* If this is a padded type, the GCC size isn't relevant
1189 to the programmer. Normally, what we want is the RM_Size,
1190 which was set from the specified size, but if it was not
1191 set, we want the size of the relevant field. Using the MAX
1192 of those two produces the right result in all case. Don't
1193 use the size of the field if it's a self-referential type,
1194 since that's never what's wanted. */
1198 {
1202 gnu_result
1205 }
1206 else
1208 }
1209 else
1215 /* Deal with a self-referential size by returning the maximum
1216 size for a type and by qualifying the size with
1217 the object for 'Size of an object. */
1221 {
1225 else
1227 }
1229 /* If the type contains a template, subtract the size of the
1230 template. */
1236 /* If the type contains a template, subtract the size of the
1237 template. */
1245 /* Always perform division using unsigned arithmetic as the
1246 size cannot be negative, but may be an overflowed positive
1247 value. This provides correct results for sizes up to 512 MB.
1248 ??? Size should be calculated in storage elements directly. */
1253 gnu_result,
1254 bitsize_unit_node)));
1261 && (TYPE_IS_PADDING_P
1270 gnu_result
1272 else
1283 {
1290 else
1291 gnu_result
1292 = build_binary_op
1294 build_binary_op
1306 }
1307 /* ... fall through ... */
1309 {
1310 int Dimension
1315 /* Emit access check if necessary */
1319 /* Make sure any implicit dereference gets done. */
1327 {
1329 tree gnu_type_temp;
1335 ;
1338 }
1347 gnu_result
1350 gnu_result
1352 else
1353 /* 'Length or 'Range_Length. */
1354 {
1355 tree gnu_compute_type
1356 = gnat_signed_or_unsigned_type
1359 gnu_result
1360 = build_binary_op
1362 build_binary_op
1364 build_binary_op
1367 TYPE_MAX_VALUE
1370 TYPE_MIN_VALUE
1374 }
1376 /* If this has a PLACEHOLDER_EXPR, qualify it by the object
1377 we are handling. Note that these attributes could not
1378 have been used on an unconstrained array type. */
1385 }
1392 {
1393 HOST_WIDE_INT bitsize;
1394 HOST_WIDE_INT bitpos;
1395 tree gnu_offset;
1396 tree gnu_field_bitpos;
1397 tree gnu_field_offset;
1398 tree gnu_inner;
1406 /* We can have 'Bit on any object, but if it isn't a
1407 COMPONENT_REF, the result is zero. Do not allow
1408 'Bit on a bare component, though. */
1412 {
1415 }
1426 {
1427 gnu_field_bitpos
1429 gnu_field_offset
1436 {
1437 gnu_field_bitpos
1441 gnu_field_offset
1445 }
1446 }
1448 {
1451 }
1452 else
1453 {
1456 }
1459 {
1471 gnu_result
1475 bitsize_one_node);
1481 }
1483 /* If this has a PLACEHOLDER_EXPR, qualify it by the object
1484 we are handling. */
1491 }
1514 && (TYPE_IS_PADDING_P
1522 gnu_type
1532 /* Note this size cannot be self-referential. */
1539 /* This is just a zero cast to the pointer type for
1540 our prefix and dereferenced. */
1542 gnu_result
1545 integer_zero_node));
1550 {
1557 {
1562 ;
1563 }
1569 || (DECL_BY_COMPONENT_PTR_P
1573 }
1577 /* Say we have an unimplemented attribute. Then set the
1578 value to be returned to be a zero and hope that's something
1579 we can convert to the type of this attribute. */
1585 }
1587 /* If this is an attribute where the prefix was unused,
1588 force a use of it if it has a side-effect. But don't do it if
1589 the prefix is just an entity name. However, if an access check
1590 is needed, we must do it. See second example in AARM 11.6(5.e). */
1596 }
1600 /* Like 'Access as far as we are concerned. */
1608 {
1609 tree gnu_aggr_type;
1611 /* ??? It is wrong to evaluate the type now, but there doesn't
1612 seem to be any other practical way of doing it. */
1614 gnu_aggr_type = gnu_result_type
1619 gnu_aggr_type
1626 gnu_result
1628 gnu_aggr_type);
1630 {
1631 /* The first element is the discrimant, which we ignore. The
1632 next is the field we're building. Convert the expression
1633 to the type of the field and then to the union type. */
1634 Node_Id gnat_assoc
1637 tree gnu_field_type
1642 }
1645 gnu_aggr_type,
1648 gnu_result
1649 = build_binary_op
1654 (Next
1656 else
1660 }
1670 /* Get the operand expression. */
1674 gnu_result
1686 /* If the result is a pointer type, see if we are improperly
1687 converting to a stricter alignment. */
1691 {
1694 unsigned int oalign
1699 post_error_ne_tree_2
1703 }
1710 {
1713 tree gnu_low;
1714 tree gnu_high;
1716 /* GNAT_RANGE is either an N_Range node or an identifier
1717 denoting a subtype. */
1719 {
1722 }
1725 {
1730 }
1731 else
1736 /* If LOW and HIGH are identical, perform an equality test.
1737 Otherwise, ensure that GNU_OBJECT is only evaluated once
1738 and perform a full range test. */
1742 else
1743 {
1745 gnu_result
1751 }
1755 }
1763 ? RDIV_EXPR
1770 {
1772 tree gnu_rhs_side;
1774 /* The elaboration of the RHS may generate code. If so,
1775 we need to make sure it gets executed after the LHS. */
1785 gnu_rhs);
1788 }
1792 /* These can either be operations on booleans or on modular types.
1793 Fall through for boolean types since that's the way GNU_CODES is
1794 set up. */
1796 Modular_Integer_Kind))
1797 {
1798 enum tree_code code
1809 }
1811 /* ... fall through ... */
1822 {
1824 tree gnu_type;
1830 /* If this is a comparison operator, convert any references to
1831 an unconstrained array value into a reference to the
1832 actual array. */
1834 {
1837 }
1839 /* If the result type is a private type, its full view may be a
1840 numeric subtype. The representation we need is that of its base
1841 type, given that it is the result of an arithmetic operation. */
1843 gnu_type = gnu_result_type
1846 /* If this is a shift whose count is not guaranteed to be correct,
1847 we need to adjust the shift count. */
1850 {
1852 tree gnu_max_shift
1860 gnu_rhs
1861 = build_binary_op
1864 gnu_count_type,
1865 gnu_max_shift,
1867 integer_one_node)),
1868 gnu_rhs);
1869 }
1871 /* For right shifts, the type says what kind of shift to do,
1872 so we may need to choose a different type. */
1881 {
1884 }
1888 /* If this is a logical shift with the shift count not verified,
1889 we must return zero if it is too large. We cannot compensate
1890 above in this case. */
1894 gnu_result
1895 = build_cond_expr
1898 gnu_rhs,
1902 gnu_result);
1903 }
1907 {
1910 tree gnu_false
1917 }
1926 /* This case can apply to a boolean or a modular type.
1927 Fall through for a boolean operand since GNU_CODES is set
1928 up to handle this. */
1930 {
1934 gnu_expr);
1936 }
1938 /* ... fall through ... */
1945 else
1954 {
1956 tree gnu_type;
1960 /* The Expression operand can either be an N_Identifier or
1961 Expanded_Name, which must represent a type, or a
1962 N_Qualified_Expression, which contains both the object type and an
1963 initial value for the object. */
1968 {
1969 Entity_Id gnat_desig_type
1980 {
1983 }
1984 else
1985 {
1991 }
1992 }
1993 else
2000 }
2003 /***************************/
2004 /* Chapter 5: Statements: */
2005 /***************************/
2009 {
2015 /* If this is the first label of an exception handler, we must
2016 mark that any CALL_INSN can jump to it. */
2020 nonlocal_goto_handler_labels
2022 nonlocal_goto_handler_labels);
2023 }
2033 /* Get the LHS and RHS of the statement and convert any reference to an
2034 unconstrained array into a reference to the underlying array. */
2036 gnu_rhs
2041 /* If range check is needed, emit code to generate it */
2045 /* If either side's type has a size that overflows, convert this
2046 into raise of Storage_Error: execution shouldn't have gotten
2047 here anyway. */
2053 else
2059 /* Start an IF statement giving the condition. */
2064 /* Generate code for the statements to be executed if the condition
2065 is true. */
2072 /* Generate each of the "else if" parts. */
2074 {
2078 {
2079 Node_Id gnat_statement;
2083 /* Set up the line numbers for each condition we test. */
2091 }
2092 }
2094 /* Finally, handle any statements in the "else" part. */
2096 {
2103 }
2109 {
2110 Node_Id gnat_when;
2111 Node_Id gnat_choice;
2112 tree gnu_label;
2113 Node_Id gnat_statement;
2124 {
2125 /* First compile all the different case choices for the current
2126 WHEN alternative. */
2130 {
2137 {
2139 /* Abort on all errors except range empty, which
2140 means we ignore this alternative. */
2141 error_code
2151 error_code
2152 = pushcase_range
2165 /* This represents either a subtype range or a static value
2166 of some kind; Ekind says which. If a static value,
2167 fall through to the next case. */
2169 {
2172 error_code
2180 }
2181 /* ... fall through ... */
2196 }
2197 }
2199 /* After compiling the choices attached to the WHEN compile the
2200 body of statements that have to be executed, should the
2201 "WHEN ... =>" be taken. Push a binding level here in case
2202 variables are declared since we want them to be local to this
2203 set of statements instead of the block containing the Case
2204 statement. */
2212 /* Communicate to GCC that we are done with the current WHEN,
2213 i.e. insert a "break" statement. */
2217 }
2220 }
2224 {
2225 /* The loop variable in GCC form, if any. */
2227 /* PREINCREMENT_EXPR or PREDECREMENT_EXPR. */
2229 /* Used if this is a named loop for so EXIT can work. */
2231 /* Condition to continue loop tested at top of loop. */
2233 /* Similar, but tested at bottom of loop. */
2235 Node_Id gnat_statement;
2240 /* Set the condition that under which the loop should continue.
2241 For "LOOP .... END LOOP;" the condition is always true. */
2243 ;
2244 /* The case "WHILE condition LOOP ..... END LOOP;" */
2247 else
2248 {
2249 /* We have an iteration scheme. */
2250 Node_Id gnat_loop_spec
2262 tree gnu_limit
2266 /* We know the loop variable will not overflow if GNU_LAST is
2267 a constant and is not equal to GNU_LIMIT. If it might
2268 overflow, we have to move the limit test to the end of
2269 the loop. In that case, we have to test for an
2270 empty loop outside the loop. */
2274 {
2280 }
2282 /* Open a new nesting level that will surround the loop to declare
2283 the loop index variable. */
2287 /* Declare the loop index and set it to its initial value. */
2291 gnu_loop_var);
2293 /* The loop variable might be a padded type, so use `convert' to
2294 get a reference to the inner variable if so. */
2297 /* Set either the top or bottom exit condition as
2298 appropriate depending on whether we know an overflow
2299 cannot occur or not. */
2301 gnu_bottom_condition
2304 else
2305 gnu_top_condition
2310 }
2315 else
2318 /* If the loop was named, have the name point to this loop. In this
2319 case, the association is not a ..._DECL node; in fact, it isn't
2320 a GCC tree node at all. Since this name is referenced inside
2321 the loop, do it before we process the statements of the loop. */
2323 {
2328 }
2332 /* We must evaluate the condition after we've entered the
2333 loop so that any expression actions get done in the right
2334 place. */
2340 /* Make the loop body into its own block, so any allocated
2341 storage will be released every iteration. This is needed
2342 for stack allocation. */
2345 gnu_block_stack
2362 {
2365 gnu_loop_var,
2367 integer_one_node));
2370 }
2376 {
2377 /* Close the nesting level that sourround the loop that was used to
2378 declare the loop index variable. */
2382 }
2385 {
2388 }
2389 }
2406 {
2407 /* Which loop to exit, NULL if the current loop. */
2409 /* The GCC version of the optional GNAT condition node attached to the
2410 exit statement. Exit the loop if this is false. */
2414 loop_id
2423 }
2430 {
2431 /* The gnu function type of the subprogram currently processed. */
2433 /* The return value from the subprogram. */
2436 /* If we are dealing with a "return;" from an Ada procedure with
2437 parameters passed by copy in copy out, we need to return a record
2438 containing the final values of these parameters. If the list
2439 contains only one entry, return just that entry.
2441 For a full description of the copy in copy out parameter mechanism,
2442 see the part of the gnat_to_gnu_entity routine dealing with the
2443 translation of subprograms.
2445 But if we have a return label defined, convert this into
2446 a branch to that label. */
2452 {
2455 else
2456 gnu_ret_val
2459 }
2461 /* If the Ada subprogram is a function, we just need to return the
2462 expression. If the subprogram returns an unconstrained
2463 array, we have to allocate a new version of the result and
2464 return it. If we return by reference, return a pointer. */
2467 {
2470 /* Do not remove the padding from GNU_RET_VAL if the inner
2471 type is self-referential since we want to allocate the fixed
2472 size in that case. */
2474 && (TYPE_IS_PADDING_P
2476 && contains_placeholder_p
2485 {
2488 /* We have two cases: either the function returns with
2489 depressed stack or not. If not, we allocate on the
2490 secondary stack. If so, we allocate in the stack frame.
2491 if no copy is needed, the front end will set By_Ref,
2492 which we handle in the case above. */
2494 gnu_ret_val
2497 else
2498 gnu_ret_val
2503 }
2504 }
2510 gnu_ret_val));
2511 else
2514 }
2527 /****************************/
2528 /* Chapter 6: Subprograms: */
2529 /****************************/
2532 /* Unless there is a freeze node, declare the subprogram. We consider
2533 this a "definition" even though we're not generating code for
2534 the subprogram because we will be making the corresponding GCC
2535 node here. */
2544 /* This subprogram doesn't exist for code generation purposes, but we
2545 have to elaborate the types of any parameters, unless they are
2546 imported types (nothing to generate in this case). */
2558 /* For a child unit identifier go up a level to get the
2559 specificaton. We get this when we try to find the spec of
2560 a child unit package that is the compilation unit being compiled. */
2565 {
2566 /* Save debug output mode in case it is reset. */
2569 /* Definining identifier of a parameter to the subprogram. */
2570 Entity_Id gnat_param;
2571 /* The defining identifier for the subprogram body. Note that if a
2572 specification has appeared before for this body, then the identifier
2573 occurring in that specification will also be a defining identifier
2574 and all the calls to this subprogram will point to that
2575 specification. */
2576 Entity_Id gnat_subprog_id
2580 /* The FUNCTION_DECL node corresponding to the subprogram spec. */
2581 tree gnu_subprog_decl;
2582 /* The FUNCTION_TYPE node corresponding to the subprogram spec. */
2583 tree gnu_subprog_type;
2584 tree gnu_cico_list;
2586 /* If this is a generic object or if it has been eliminated,
2587 ignore it. */
2594 /* If debug information is suppressed for the subprogram,
2595 turn debug mode off for the duration of processing. */
2597 {
2600 }
2602 /* If this subprogram acts as its own spec, define it. Otherwise,
2603 just get the already-elaborated tree node. However, if this
2604 subprogram had its elaboration deferred, we will already have
2605 made a tree node for it. So treat it as not being defined in
2606 that case. Such a subprogram cannot have an address clause or
2607 a freeze node, so this test is safe, though it does disable
2608 some otherwise-useful error checking. */
2609 gnu_subprog_decl
2616 /* Set the line number in the decl to correspond to that of
2617 the body so that the line number notes are written
2618 correctly. */
2632 /* If there are OUT parameters, we need to ensure that the
2633 return statement properly copies them out. We do this by
2634 making a new block and converting any inner return into a goto
2635 to a label at the end of the block. */
2638 {
2639 gnu_return_label_stack
2642 gnu_return_label_stack);
2645 }
2646 else
2647 gnu_return_label_stack
2650 /* See if there are any parameters for which we don't yet have
2651 GCC entities. These must be for OUT parameters for which we
2652 will be making VAR_DECL nodes here. Fill them in to
2653 TYPE_CI_CO_LIST, which must contain the empty entry as well.
2654 We can match up the entries because TYPE_CI_CO_LIST is in the
2655 order of the parameters. */
2662 else
2663 {
2664 /* Skip any entries that have been already filled in; they
2665 must correspond to IN OUT parameters. */
2668 ;
2670 /* Do any needed references for padded types. */
2674 }
2678 /* Generate the code of the subprogram itself. A return statement
2679 will be present and any OUT parameters will be handled there. */
2687 {
2688 tree gnu_retval;
2698 else
2700 gnu_cico_list);
2703 gnu_retval
2706 expand_return
2709 gnu_retval));
2711 }
2715 /* Disconnect the trees for parameters that we made variables for
2716 from the GNAT entities since these will become unusable after
2717 we end the function. */
2728 }
2737 {
2738 /* The GCC node corresponding to the GNAT subprogram name. This can
2739 either be a FUNCTION_DECL node if we are dealing with a standard
2740 subprogram call, or an indirect reference expression (an
2741 INDIRECT_REF node) pointing to a subprogram. */
2743 /* The FUNCTION_TYPE node giving the GCC type of the subprogram. */
2745 tree gnu_subprog_addr
2747 Entity_Id gnat_formal;
2748 Node_Id gnat_actual;
2752 tree gnu_subprog_call;
2755 {
2763 }
2768 /* If we are calling a stubbed function, make this into a
2769 raise of Program_Error. Elaborate all our args first. */
2773 {
2780 {
2782 gnu_result
2785 }
2786 else
2787 expand_expr_stmt
2790 }
2792 /* The only way we can be making a call via an access type is
2793 if Name is an explicit dereference. In that case, get the
2794 list of formal args from the type the access type is pointing
2795 to. Otherwise, get the formals from entity being called. */
2799 /* Assume here that this must be 'Elab_Body or 'Elab_Spec. */
2801 else
2804 /* Create the list of the actual parameters as GCC expects it, namely
2805 a chain of TREE_LIST nodes in which the TREE_VALUE field of each
2806 node is a parameter-expression and the TREE_PURPOSE field is
2807 null. Skip OUT parameters that are not passed by reference. */
2813 {
2815 Node_Id gnat_name
2820 tree gnu_actual;
2822 /* If it's possible we may need to use this expression twice,
2823 make sure than any side-effects are handled via SAVE_EXPRs.
2824 Likewise if we need to force side-effects before the call.
2825 ??? This is more conservative than we need since we don't
2826 need to do this for pass-by-ref with no conversion.
2827 If we are passing a non-addressable Out or In Out parameter by
2828 reference, pass the address of a copy and set up to copy back
2829 out after the call. */
2832 {
2839 {
2842 /* Remove any unpadding on the actual and make a copy.
2843 But if the actual is a left-justified modular type,
2844 first convert to it. */
2846 && (TYPE_IS_PADDING_P
2850 && (TYPE_LEFT_JUSTIFIED_MODULAR_P
2856 /* Set up to move the copy back to the original. */
2858 gnu_after_list);
2861 }
2862 }
2864 /* If this was a procedure call, we may not have removed any
2865 padding. So do it here for the part we will use as an
2866 input, if any. */
2872 gnu_actual);
2879 /* Do any needed conversions. We need only check for
2880 unchecked conversion since normal conversions will be handled
2881 by just converting to the formal type. */
2883 {
2884 gnu_actual
2886 gnu_actual);
2888 /* One we've done the unchecked conversion, we still
2889 must ensure that the object is in range of the formal's
2890 type. */
2895 }
2896 else
2897 /* We may have suppressed a conversion to the Etype of the
2898 actual since the parent is a procedure call. So add the
2899 conversion here. */
2901 gnu_actual);
2905 /* If we have not saved a GCC object for the formal, it means
2906 it is an OUT parameter not passed by reference. Otherwise,
2907 look at the PARM_DECL to see if it is passed by reference. */
2911 {
2913 {
2916 /* If we have a padded type, be sure we've removed the
2917 padding. */
2920 gnu_actual
2922 gnu_actual);
2923 }
2925 /* The symmetry of the paths to the type of an entity is
2926 broken here since arguments don't know that they will
2927 be passed by ref. */
2930 gnu_actual);
2931 }
2935 {
2942 {
2943 gnu_formal_type
2946 }
2948 /* Take the address of the object and convert to the
2949 proper pointer type. We'd like to actually compute
2950 the address of the beginning of the array using
2951 an ADDR_EXPR of an ARRAY_REF, but there's a possibility
2952 that the ARRAY_REF might return a constant and we'd
2953 be getting the wrong address. Neither approach is
2954 exactly correct, but this is the most likely to work
2955 in all cases. */
2958 gnu_actual));
2959 }
2963 {
2964 /* If arg is 'Null_Parameter, pass zero descriptor. */
2968 gnu_actual
2970 integer_zero_node);
2971 else
2972 gnu_actual
2975 gnat_formal));
2976 }
2977 else
2978 {
2982 gnu_name_list
2990 /* If this is 'Null_Parameter, pass a zero even though we are
2991 dereferencing it. */
2996 BITS_PER_WORD))
2997 gnu_actual
2998 = unchecked_convert
3002 integer_zero_node));
3003 else
3004 gnu_actual
3007 gnu_actual);
3008 }
3010 gnu_actual_list
3013 }
3017 NULL_TREE);
3020 /* If it is a function call, the result is the call expression. */
3022 {
3025 /* If the function returns an unconstrained array or by reference,
3026 we have to de-dereference the pointer. */
3030 gnu_result);
3033 }
3035 /* If this is the case where the GNAT tree contains a procedure call
3036 but the Ada procedure has copy in copy out parameters, the special
3037 parameter passing mechanism must be used. */
3039 {
3040 /* List of FIELD_DECLs associated with the PARM_DECLs of the copy
3041 in copy out parameters. */
3046 {
3047 tree gnu_name;
3051 /* If any of the names had side-effects, ensure they are
3052 all evaluated before the call. */
3056 gnu_subprog_call
3059 }
3063 else
3070 /* If we are dealing with a copy in copy out parameter, we must
3071 retrieve its value from the record returned in the function
3072 call. */
3076 || (DECL_BY_COMPONENT_PTR_P
3080 {
3081 /* Get the value to assign to this OUT or IN OUT
3082 parameter. It is either the result of the function if
3083 there is only a single such parameter or the appropriate
3084 field from the record returned. */
3085 tree gnu_result
3087 : build_component_ref
3090 int unchecked_conversion
3092 /* If the actual is a conversion, get the inner expression,
3093 which will be the real destination, and convert the
3094 result to the type of the actual parameter. */
3095 tree gnu_actual
3098 /* If the result is a padded type, remove the padding. */
3101 gnu_result
3104 gnu_result);
3106 /* If the result is a type conversion, do it. */
3108 gnu_result
3109 = convert_with_check
3116 gnu_result
3118 else
3119 {
3129 gnu_result);
3130 }
3137 }
3138 }
3139 else
3140 {
3143 }
3145 /* Handle anything we need to assign back. */
3147 gnu_expr;
3152 }
3155 /*************************/
3156 /* Chapter 7: Packages: */
3157 /*************************/
3171 /* If this is the body of a generic package - do nothing */
3178 {
3182 }
3185 /*********************************/
3186 /* Chapter 8: Visibility Rules: */
3187 /*********************************/
3191 /* Nothing to do here - but these may appear in list of declarations */
3194 /***********************/
3195 /* Chapter 9: Tasks: */
3196 /***********************/
3205 /***********************************************************/
3206 /* Chapter 10: Program Structure and Compilation Issues: */
3207 /***********************************************************/
3211 /* For a body, first process the spec if there is one. */
3220 {
3227 };
3234 /* Process any pragmas following the unit. */
3240 /* Put all the Actions into the elaboration routine if we already had
3241 elaborations. This will happen anyway if they are statements, but we
3242 want to force declarations there too due to order-of-elaboration
3243 issues. Most should have Is_Statically_Allocated set. If we
3244 have had no elaborations, we have no order-of-elaboration issue and
3245 don't want to create elaborations here. */
3249 {
3253 else
3255 }
3257 /* Generate elaboration code for this unit, if necessary, and
3258 say whether we did or not. */
3259 Set_Has_No_Elaboration_Code
3261 build_unit_elab
3273 /* Simply process whatever unit is being inserted. */
3281 /***************************/
3282 /* Chapter 11: Exceptions: */
3283 /***************************/
3287 /* The GCC exception handling mechanism can handle both ZCX and SJLJ
3288 schemes and we have our own SJLJ mechanism. To call the GCC
3289 mechanism, we first call expand_eh_region_start if there is at least
3290 one handler associated with the region. We then generate code for
3291 the region and call expand_start_all_catch to announce that the
3292 associated handlers are going to be generated.
3294 For each handler we call expand_start_catch, generate code for the
3295 handler, and then call expand_end_catch.
3297 After all the handlers, we call expand_end_all_catch.
3299 Here we deal with the region level calls and the
3300 N_Exception_Handler branch deals with the handler level calls
3301 (start_catch/end_catch).
3303 ??? The region level calls down there have been specifically put in
3304 place for a ZCX context and currently the order in which things are
3305 emitted (region/handlers) is different from the SJLJ case. Instead of
3306 putting other calls with different conditions at other places for the
3307 SJLJ case, it seems cleaner to reorder things for the SJLJ case and
3308 generalize the condition to make it not ZCX specific. */
3310 /* Tell the back-end we are starting a new exception region if
3311 necessary. */
3317 /* If there are exception handlers, start a new binding level that
3318 we can exit (since each exception handler will do so). Then
3319 declare a variable to save the old __gnat_jmpbuf value and a
3320 variable for our jmpbuf. Call setjmp and handle each of the
3321 possible exceptions if it returns one. */
3324 {
3328 tree gnu_cleanup_decl;
3334 {
3335 gnu_jmpsave_decl
3337 jmpbuf_ptr_type,
3346 }
3348 /* See if we are to call a function when exiting this block. */
3350 {
3351 gnu_cleanup_call
3354 gnu_cleanup_decl
3360 }
3363 {
3364 /* When we exit this block, restore the saved value. */
3367 gnu_jmpsave_decl));
3369 /* Call setjmp and handle exceptions if it returns one. */
3371 expand_start_cond
3374 gnu_jmpbuf_decl)),
3377 /* Restore our incoming longjmp value before we do anything. */
3379 gnu_jmpsave_decl));
3384 gnu_except_ptr_stack
3386 create_var_decl
3391 gnu_except_ptr_stack);
3393 /* Generate code for each exception handler. The code at
3394 N_Exception_Handler below does the real work. Note that
3395 we ignore the dummy exception handler for the identifier
3396 case, this is used only by the front end */
3404 /* If none of the exception handlers did anything, re-raise
3405 but do not defer abortion. */
3407 expand_expr_stmt
3415 /* End the "if" on setjmp. Note that we have arranged things so
3416 control never returns here. */
3419 /* This is now immediately before the body proper. Set
3420 our jmp_buf as the current buffer. */
3421 expand_expr_stmt
3424 gnu_jmpbuf_decl)));
3425 }
3426 }
3428 /* If there are no exception handlers, we must not have an at end
3429 cleanup identifier, since the cleanup identifier should always
3430 generate a corresponding exception handler, except in the case
3431 of the No_Exception_Handlers restriction, where the front-end
3432 does not generate exception handlers. */
3434 {
3436 {
3438 tree gnu_cleanup_decl;
3440 gnu_cleanup_call
3443 gnu_cleanup_decl
3449 }
3450 else
3452 }
3454 /* Generate code and declarations for the prefix of this block,
3455 if any. */
3460 /* Generate code for each statement in the block. */
3467 /* Tell the back-end we are ending the new exception region and
3468 starting the associated handlers. */
3474 /* For zero-cost exceptions, exit the block and then compile
3475 the handlers. */
3479 {
3485 }
3487 /* We don't support Front_End_ZCX in GNAT 5.0, but we don't want to
3488 crash if -gnatdX is specified. */
3492 {
3497 }
3499 /* Tell the backend when we are done with the handlers. */
3505 /* If we have handlers, close the block we made. */
3507 {
3510 }
3516 {
3517 /* Unless this is "Others" or the special "Non-Ada" exception
3518 for Ada, make an "if" statement to select the proper
3519 exceptions. For "Others", exclude exceptions where
3520 Handled_By_Others is nonzero unless the All_Others flag is set.
3521 For "Non-ada", accept an exception if "Lang" is 'V'. */
3526 {
3527 tree this_choice;
3530 {
3533 else
3534 this_choice
3535 = build_binary_op
3537 convert
3539 build_component_ref
3540 (build_unary_op
3544 integer_zero_node);
3545 }
3549 {
3550 /* ??? Note that we have to use gnat_to_gnu_entity here
3551 since the type of the exception will be wrong in the
3552 VMS case and that's exactly what this test is for. */
3553 gnu_expr
3556 /* If this was a VMS exception, check import_code
3557 against the value of the exception. */
3559 this_choice
3560 = build_binary_op
3562 build_component_ref
3563 (build_unary_op
3567 gnu_expr);
3568 else
3569 this_choice
3570 = build_binary_op
3573 convert
3577 /* If this is the distinguished exception "Non_Ada_Error"
3578 (and we are in VMS mode), also allow a non-Ada
3579 exception (a VMS condition) to match. */
3581 {
3582 tree gnu_comp
3583 = build_component_ref
3584 (build_unary_op
3589 this_choice
3590 = build_binary_op
3592 build_binary_op
3596 this_choice);
3597 }
3598 }
3599 else
3604 }
3609 }
3611 /* Tell the back end that we start an exception handler if necessary. */
3613 {
3614 /* We build a TREE_LIST of nodes representing what exception
3615 types this handler is able to catch, with special cases
3616 for others and all others cases.
3618 Each exception type is actually identified by a pointer to the
3619 exception id, with special value zero for "others" and one for
3620 "all others". Beware that these special values are known and used
3621 by the personality routine to identify the corresponding specific
3622 kinds of handlers.
3624 ??? For initial time frame reasons, the others and all_others
3625 cases have been handled using specific type trees, but this
3626 somehow hides information to the back-end, which expects NULL to
3627 be passed for catch all and end_cleanup to be used for cleanups.
3629 Care should be taken to ensure that the control flow impact of
3630 such clauses is rendered in some way. lang_eh_type_covers is
3631 doing the trick currently.
3633 ??? Should investigate the possible usage of the end_cleanup
3634 interface in this context. */
3641 {
3643 gnu_etype
3648 {
3652 }
3653 else
3656 gnu_etypes_list
3659 /* The GCC interface expects NULL to be passed for catch all
3660 handlers, so the approach below is quite tempting :
3662 if (gnu_etype == integer_zero_node)
3663 gnu_etypes_list = NULL;
3665 It would not work, however, because GCC's notion
3666 of "catch all" is stronger than our notion of "others".
3668 Until we correctly use the cleanup interface as well, the
3669 two lines above will prevent the "all others" handlers from
3670 beeing seen, because nothing can be caught beyond a catch
3671 all from GCC's point of view. */
3672 }
3675 }
3681 /* At the end of the handler, exit the block. We made this block
3682 in N_Handled_Sequence_Of_Statements. */
3685 /* Tell the back end that we're done with the current handler. */
3693 /*******************************/
3694 /* Chapter 12: Generic Units: */
3695 /*******************************/
3705 /* These nodes can appear on a declaration list but there is nothing to
3706 to be done with them. */
3709 /***************************************************/
3710 /* Chapter 13: Representation Clauses and */
3711 /* Implementation-Dependent Features: */
3712 /***************************************************/
3716 /* The only one we need deal with is for 'Address. For the others, SEM
3717 puts the information elsewhere. We need only deal with 'Address
3718 if the object has a Freeze_Node (which it never will currently). */
3723 /* Get the value to use as the address and save it as the
3724 equivalent for GNAT_TEMP. When the object is frozen,
3725 gnat_to_gnu_entity will do the right thing. */
3733 /* We do nothing with these. SEM puts the information elsewhere. */
3738 {
3744 /* First process inputs, then outputs, then clobbers. */
3747 {
3752 gnu_input_list
3755 }
3759 {
3764 gnu_orig_out_list
3766 gnu_output_list
3769 }
3773 gnu_clobber_list
3776 gnu_clobber_list);
3785 /* Copy all the intermediate outputs into the specified outputs. */
3790 {
3791 expand_expr_stmt
3796 }
3797 }
3800 /***************************************************/
3801 /* Added Nodes */
3802 /***************************************************/
3816 {
3818 tree gnu_obj_type;
3819 tree gnu_obj_size;
3822 /* If this is an unconstrained array, we know the object must
3823 have been allocated with the template in front of the object.
3824 So pass the template address, but get the total size. Do this
3825 by converting to a thin pointer. */
3827 gnu_ptr
3829 (TYPE_OBJECT_RECORD_TYPE
3831 gnu_ptr);
3839 {
3842 tree gnu_byte_offset
3849 }
3852 expand_expr_stmt
3856 }
3869 /* If the type is VOID, this is a statement, so we need to
3870 generate the code for the call. Handle a Condition, if there
3871 is one. */
3873 {
3883 }
3884 else
3888 /* Nothing to do, since front end does all validation using the
3889 values that Gigi back-annotates. */
3902 }
3904 /* If the result is a constant that overflows, raise constraint error. */
3907 {
3910 gnu_result
3913 }
3915 /* If our result has side-effects and is of an unconstrained type,
3916 make a SAVE_EXPR so that we can be sure it will only be referenced
3917 once. Note we must do this before any conversions. */
3924 /* Now convert the result to the proper type. If the type is void or if
3925 we have no result, return error_mark_node to show we have no result.
3926 If the type of the result is correct or if we have a label (which doesn't
3927 have any well-defined type), return our result. Also don't do the
3928 conversion if the "desired" type involves a PLACEHOLDER_EXPR in its size
3929 since those are the cases where the front end may have the type wrong due
3930 to "instantiating" the unconstrained record with discriminant values
3931 or if this is a FIELD_DECL. If this is the Name of an assignment
3932 statement or a parameter of a procedure call, return what we have since
3933 the RHS has to be converted to our type there in that case, unless
3934 GNU_RESULT_TYPE has a simpler size. Similarly, if the two types are
3935 record types with the same name, the expression type has integral mode,
3936 and GNU_RESULT_TYPE BLKmode, don't convert. This will be the case when
3937 we are converting from a packable type to its actual type and we need
3938 those conversions to be NOPs in order for assignments into these types to
3939 work properly if the inner object is a bitfield and hence can't have
3940 its address taken. Finally, don't convert integral types that are the
3941 operand of an unchecked conversion since we need to ignore those
3942 conversions (for 'Valid). Otherwise, convert the result to the proper
3943 type. */
3965 && (contains_placeholder_p
3969 {
3970 /* In this case remove padding only if the inner object is of
3971 self-referential size: in that case it must be an object of
3972 unconstrained type with a default discriminant. In other cases,
3973 we want to avoid copying too much data. */
3980 gnu_result);
3981 }
3997 {
3998 /* Remove any padding record, but do nothing more in this case. */
4002 gnu_result);
4003 }
4011 /* We don't need any NOP_EXPR or NON_LVALUE_EXPR on GNU_RESULT. */
4018 }
4019 \f
4020 /* Force references to each of the entities in packages GNAT_NODE with's
4021 so that the debugging information for all of them are identical
4022 in all clients. Operate recursively on anything it with's, but check
4023 that we aren't elaborating something more than once. */
4025 /* The reason for this routine's existence is two-fold.
4026 First, with some debugging formats, notably MDEBUG on SGI
4027 IRIX, the linker will remove duplicate debugging information if two
4028 clients have identical debugguing information. With the normal scheme
4029 of elaboration, this does not usually occur, since entities in with'ed
4030 packages are elaborated on demand, and if clients have different usage
4031 patterns, the normal case, then the order and selection of entities
4032 will differ. In most cases however, it seems that linkers do not know
4033 how to eliminate duplicate debugging information, even if it is
4034 identical, so the use of this routine would increase the total amount
4035 of debugging information in the final executable.
4037 Second, this routine is called in type_annotate mode, to compute DDA
4038 information for types in withed units, for ASIS use */
4040 static void
4042 Node_Id gnat_node;
4043 {
4048 /* Save entities in all context units. A body may have an implicit_with
4049 on its own spec, if the context includes a child unit, so don't save
4050 the spec twice. */
4058 {
4078 }
4082 }
4083 \f
4084 /* Do the processing of N_Freeze_Entity, GNAT_NODE. */
4086 static void
4088 Node_Id gnat_node;
4089 {
4091 tree gnu_old;
4092 tree gnu_new;
4093 tree gnu_init
4098 /* If this is a package, need to generate code for the package. */
4100 {
4101 insert_code_for
4105 }
4107 /* Check for old definition after the above call. This Freeze_Node
4108 might be for one its Itypes. */
4109 gnu_old
4112 /* If this entity has an Address representation clause, GNU_OLD is the
4113 address, so discard it here. */
4117 /* Don't do anything for class-wide types they are always
4118 transformed into their root type. */
4124 /* Don't do anything for subprograms that may have been elaborated before
4125 their freeze nodes. This can happen, for example because of an inner call
4126 in an instance body. */
4133 /* If we have a non-dummy type old tree, we have nothing to do. Unless
4134 this is the public view of a private type whose full view was not
4135 delayed, this node was never delayed as it should have been.
4136 Also allow this to happen for concurrent types since we may have
4137 frozen both the Corresponding_Record_Type and this type. */
4141 {
4148 else
4150 }
4152 /* Reset the saved tree, if any, and elaborate the object or type for real.
4153 If there is a full declaration, elaborate it and copy the type to
4154 GNAT_ENTITY. Likewise if this is the record subtype corresponding to
4155 a class wide type or subtype. */
4157 {
4166 }
4170 {
4173 /* The above call may have defined this entity (the simplest example
4174 of this is when we have a private enumeral type since the bounds
4175 will have the public view. */
4181 }
4182 else
4185 /* If we've made any pointers to the old version of this type, we
4186 have to update them. */
4190 }
4191 \f
4192 /* Process the list of inlined subprograms of GNAT_NODE, which is an
4193 N_Compilation_Unit. */
4195 static void
4197 Node_Id gnat_node;
4198 {
4199 Entity_Id gnat_entity;
4200 Node_Id gnat_body;
4202 /* If we can inline, generate RTL for all the inlined subprograms.
4203 Define the entity first so we set DECL_EXTERNAL. */
4208 {
4212 {
4213 /* ??? This really should always be Present. */
4217 gnat_body
4219 }
4222 {
4225 }
4226 }
4227 }
4228 \f
4229 /* Elaborate decls in the lists GNAT_DECLS and GNAT_DECLS2, if present.
4230 We make two passes, one to elaborate anything other than bodies (but
4231 we declare a function if there was no spec). The second pass
4232 elaborates the bodies.
4234 GNAT_END_LIST gives the element in the list past the end. Normally,
4235 this is Empty, but can be First_Real_Statement for a
4236 Handled_Sequence_Of_Statements.
4238 We make a complete pass through both lists if PASS1P is true, then make
4239 the second pass over both lists if PASS2P is true. The lists usually
4240 correspond to the public and private parts of a package. */
4242 static void
4245 Node_Id gnat_end_list;
4247 {
4249 Node_Id gnat_decl;
4259 {
4262 /* For package specs, we recurse inside the declarations,
4263 thus taking the two pass approach inside the boundary. */
4271 /* Similarly for any declarations in the actions of a
4272 freeze node. */
4274 {
4277 }
4279 /* Package bodies with freeze nodes get their elaboration deferred
4280 until the freeze node, but the code must be placed in the right
4281 place, so record the code position now. */
4289 (Corresponding_Spec
4292 record_code_position
4295 /* We defer most subprogram bodies to the second pass.
4296 However, Init_Proc subprograms cannot be defered, but luckily
4297 don't need to be. */
4301 {
4303 {
4309 }
4310 }
4311 /* For bodies and stubs that act as their own specs, the entity
4312 itself must be elaborated in the first pass, because it may
4313 be used in other declarations. */
4315 {
4316 Node_Id gnat_subprog_id =
4323 }
4325 /* Concurrent stubs stand for the corresponding subprogram bodies,
4326 which are deferred like other bodies. */
4329 ;
4331 else
4333 }
4335 /* Here we elaborate everything we deferred above except for package bodies,
4336 which are elaborated at their freeze nodes. Note that we must also
4337 go inside things (package specs and freeze nodes) the first pass did. */
4343 {
4361 }
4362 }
4363 \f
4364 /* Emits an access check. GNU_EXPR is the expression that needs to be
4365 checked against the NULL pointer. */
4367 static tree
4369 tree gnu_expr;
4370 {
4371 tree gnu_check_expr;
4373 /* Checked expressions must be evaluated only once. */
4376 /* Technically, we check a fat pointer against two words of zero. However,
4377 that's wasteful and really doesn't protect against null accesses. It
4378 makes more sense to check oly the array pointer. */
4380 gnu_check_expr
4387 gnu_check_expr,
4389 integer_zero_node)),
4390 gnu_expr,
4391 CE_Access_Check_Failed);
4392 }
4394 /* Emits a discriminant check. GNU_EXPR is the expression to be checked and
4395 GNAT_NODE a N_Selected_Component node. */
4397 static tree
4399 tree gnu_expr;
4400 Node_Id gnat_node;
4401 {
4402 Entity_Id orig_comp
4405 tree gnu_discr_fct;
4406 Entity_Id gnat_discr;
4408 tree gnu_cond;
4409 Entity_Id gnat_pref_type;
4410 tree gnu_pref_type;
4414 else
4415 {
4418 /* For an untagged derived type, use the discriminants of the parent,
4419 which have been renamed in the derivation, possibly by a one-to-many
4420 constraint. */
4425 }
4432 /* Checked expressions must be evaluated only once. */
4435 /* Create the list of the actual parameters as GCC expects it.
4436 This list is the list of the discriminant fields of the
4437 record expression to be discriminant checked. For documentation
4438 on what is the GCC format for this list see under the
4439 N_Function_Call case */
4443 {
4448 }
4450 gnu_pref_type
4455 {
4456 Entity_Id gnat_real_discr
4462 gnu_actual_list
4465 build_component_ref
4468 }
4473 gnu_actual_list,
4474 NULL_TREE);
4477 return
4478 build_unary_op
4483 gnu_expr),
4484 CE_Discriminant_Check_Failed));
4485 }
4486 \f
4487 /* Emit code for a range check. GNU_EXPR is the expression to be checked,
4488 GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against
4489 which we have to check. */
4491 static tree
4493 tree gnu_expr;
4494 Entity_Id gnat_range_type;
4495 {
4501 /* If GNU_EXPR has an integral type that is narrower than GNU_RANGE_TYPE,
4502 we can't do anything since we might be truncating the bounds. No
4503 check is needed in this case. */
4509 /* Checked expressions must be evaluated only once. */
4512 /* There's no good type to use here, so we might as well use
4513 integer_type_node. Note that the form of the check is
4514 (not (expr >= lo)) or (not (expr >= hi))
4515 the reason for this slightly convoluted form is that NaN's
4516 are not considered to be in range in the float case. */
4517 return emit_check
4519 invert_truthvalue
4523 invert_truthvalue
4527 gnu_high)))),
4529 }
4530 \f
4531 /* Emit code for an index check. GNU_ARRAY_OBJECT is the array object
4532 which we are about to index, GNU_EXPR is the index expression to be
4533 checked, GNU_LOW and GNU_HIGH are the lower and upper bounds
4534 against which GNU_EXPR has to be checked. Note that for index
4535 checking we cannot use the emit_range_check function (although very
4536 similar code needs to be generated in both cases) since for index
4537 checking the array type against which we are checking the indeces
4538 may be unconstrained and consequently we need to retrieve the
4539 actual index bounds from the array object itself
4540 (GNU_ARRAY_OBJECT). The place where we need to do that is in
4541 subprograms having unconstrained array formal parameters */
4543 static tree
4545 tree gnu_array_object;
4546 tree gnu_expr;
4547 tree gnu_low;
4548 tree gnu_high;
4549 {
4550 tree gnu_expr_check;
4552 /* Checked expressions must be evaluated only once. */
4555 /* Must do this computation in the base type in case the expression's
4556 type is an unsigned subtypes. */
4559 /* If GNU_LOW or GNU_HIGH are a PLACEHOLDER_EXPR, qualify them by
4560 the object we are handling. */
4569 /* There's no good type to use here, so we might as well use
4570 integer_type_node. */
4571 return emit_check
4574 gnu_expr_check,
4576 gnu_low)),
4578 gnu_expr_check,
4580 gnu_high))),
4582 }
4583 \f
4584 /* Given GNU_COND which contains the condition corresponding to an access,
4585 discriminant or range check, of value GNU_EXPR, build a COND_EXPR
4586 that returns GNU_EXPR if GNU_COND is false and raises a
4587 CONSTRAINT_ERROR if GNU_COND is true. REASON is the code that says
4588 why the exception was raised. */
4590 static tree
4592 tree gnu_cond;
4593 tree gnu_expr;
4595 {
4596 tree gnu_call;
4597 tree gnu_result;
4601 /* Use an outer COMPOUND_EXPR to make sure that GNU_EXPR will get evaluated
4602 in front of the comparison in case it ends up being a SAVE_EXPR. Put the
4603 whole thing inside its own SAVE_EXPR so the inner SAVE_EXPR doesn't leak
4604 out. */
4608 gnu_expr));
4610 /* If GNU_EXPR has side effects, make the outer COMPOUND_EXPR and
4611 protect it. Otherwise, show GNU_RESULT has no side effects: we
4612 don't need to evaluate it just for the check. */
4614 gnu_result
4616 else
4619 /* ??? Unfortunately, if we don't put a SAVE_EXPR around this whole thing,
4620 we will repeatedly do the test. It would be nice if GCC was able
4621 to optimize this and only do it once. */
4623 }
4624 \f
4625 /* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing
4626 overflow checks if OVERFLOW_P is nonzero and range checks if
4627 RANGE_P is nonzero. GNAT_TYPE is known to be an integral type.
4628 If TRUNCATE_P is nonzero, do a float to integer conversion with
4629 truncation; otherwise round. */
4631 static tree
4633 Entity_Id gnat_type;
4634 tree gnu_expr;
4638 {
4650 /* If we are not doing any checks, the output is an integral type, and
4651 the input is not a floating type, just do the conversion. This
4652 shortcut is required to avoid problems with packed array types
4653 and simplifies code in all cases anyway. */
4658 /* First convert the expression to its base type. This
4659 will never generate code, but makes the tests below much simpler.
4660 But don't do this if converting from an integer type to an unconstrained
4661 array type since then we need to get the bounds from the original
4662 (unpacked) type. */
4666 /* If overflow checks are requested, we need to be sure the result will
4667 fit in the output base type. But don't do this if the input
4668 is integer and the output floating-point. */
4671 {
4672 /* Ensure GNU_EXPR only gets evaluated once. */
4676 /* Convert the lower bounds to signed types, so we're sure we're
4677 comparing them properly. Likewise, convert the upper bounds
4678 to unsigned types. */
4692 /* Check each bound separately and only if the result bound
4693 is tighter than the bound on the input type. Note that all the
4694 types are base types, so the bounds must be constant. Also,
4695 the comparison is done in the base type of the input, which
4696 always has the proper signedness. First check for input
4697 integer (which means output integer), output float (which means
4698 both float), or mixed, in which case we always compare.
4699 Note that we have to do the comparison which would *fail* in the
4700 case of an error since if it's an FP comparison and one of the
4701 values is a NaN or Inf, the comparison will fail. */
4708 gnu_cond
4709 = invert_truthvalue
4712 gnu_out_lb)));
4720 gnu_cond
4722 invert_truthvalue
4724 gnu_input,
4726 gnu_out_ub))));
4730 CE_Overflow_Check_Failed);
4731 }
4733 /* Now convert to the result base type. If this is a non-truncating
4734 float-to-integer conversion, round. */
4737 {
4747 gnu_result
4749 }
4755 else
4758 /* Finally, do the range check if requested. Note that if the
4759 result type is a modular type, the range check is actually
4760 an overflow check. */
4768 }
4769 \f
4770 /* Return 1 if GNU_EXPR can be directly addressed. This is the case
4771 unless it is an expression involving computation or if it involves
4772 a bitfield reference. This returns the same as
4773 gnat_mark_addressable in most cases. */
4775 static int
4777 tree gnu_expr;
4778 {
4780 {
4805 {
4806 /* This is addressable if we can avoid a copy. */
4820 }
4824 }
4825 }
4826 \f
4827 /* Do the processing for the declaration of a GNAT_ENTITY, a type. If
4828 a separate Freeze node exists, delay the bulk of the processing. Otherwise
4829 make a GCC type for GNAT_ENTITY and set up the correspondance. */
4831 void
4833 Entity_Id gnat_entity;
4834 {
4835 tree gnu_old
4837 tree gnu_new;
4839 /* If we are to delay elaboration of this type, just do any
4840 elaborations needed for expressions within the declaration and
4841 make a dummy type entry for this node and its Full_View (if
4842 any) in case something points to it. Don't do this if it
4843 has already been done (the only way that can happen is if
4844 the private completion is also delayed). */
4850 {
4854 {
4863 }
4866 }
4868 /* If we saved away a dummy type for this node it means that this
4869 made the type that corresponds to the full type of an incomplete
4870 type. Clear that type for now and then update the type in the
4871 pointers. */
4873 {
4876 {
4877 /* If this was a withed access type, this is not an error
4878 and merely indicates we've already elaborated the type
4879 already. */
4884 }
4887 }
4889 /* Now fully elaborate the type. */
4894 /* If we have an old type and we've made pointers to this type,
4895 update those pointers. */
4900 /* If this is a record type corresponding to a task or protected type
4901 that is a completion of an incomplete type, perform a similar update
4902 on the type. */
4903 /* ??? Including protected types here is a guess. */
4908 {
4909 tree gnu_task_old
4919 }
4920 }
4921 \f
4922 /* GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate.
4923 GNU_TYPE is the GCC type of the corresponding record.
4925 Return a CONSTRUCTOR to build the record. */
4927 static tree
4929 Node_Id gnat_assoc;
4930 tree gnu_type;
4931 {
4934 /* We test for GNU_FIELD being empty in the case where a variant
4935 was the last thing since we don't take things off GNAT_ASSOC in
4936 that case. We check GNAT_ASSOC in case we have a variant, but it
4937 has no fields. */
4941 {
4946 /* The expander is supposed to put a single component selector name
4947 in every record component association */
4951 /* Before assigning a value in an aggregate make sure range checks
4952 are done if required. Then convert to the type of the field. */
4958 /* Add the field and expression to the list. */
4960 }
4964 /* Verify every enty in GNU_LIST was used. */
4970 }
4972 /* Builds a possibly nested constructor for array aggregates. GNAT_EXPR
4973 is the first element of an array aggregate. It may itself be an
4974 aggregate (an array or record aggregate). GNU_ARRAY_TYPE is the gnu type
4975 corresponding to the array aggregate. GNAT_COMPONENT_TYPE is the type
4976 of the array component. It is needed for range checking. */
4978 static tree
4980 Node_Id gnat_expr;
4981 tree gnu_array_type;
4982 Entity_Id gnat_component_type;
4983 {
4984 tree gnu_expr;
4988 {
4989 /* If the expression is itself an array aggregate then first build the
4990 innermost constructor if it is part of our array (multi-dimensional
4991 case). */
4998 gnat_component_type);
4999 else
5000 {
5003 /* before assigning the element to the array make sure it is
5004 in range */
5007 }
5009 gnu_expr_list
5011 gnu_expr_list);
5012 }
5015 }
5016 \f
5017 /* Subroutine of assoc_to_constructor: VALUES is a list of field associations,
5018 some of which are from RECORD_TYPE. Return a CONSTRUCTOR consisting
5019 of the associations that are from RECORD_TYPE. If we see an internal
5020 record, make a recursive call to fill it in as well. */
5022 static tree
5024 tree values;
5025 tree record_type;
5026 {
5031 {
5034 /* _Parent is an internal field, but may have values in the aggregate,
5035 so check for values first. */
5037 {
5040 }
5043 {
5048 }
5049 else
5050 /* If we have a record subtype, the names will match, but not the
5051 actual FIELD_DECLs. */
5054 {
5057 }
5063 }
5066 }
5067 \f
5068 /* EXP is to be treated as an array or record. Handle the cases when it is
5069 an access object and perform the required dereferences. */
5071 static tree
5073 tree exp;
5074 {
5075 /* If the type is a pointer, dereference it. */
5080 /* If we got a padded type, remove it too. */
5086 }
5087 \f
5088 /* Protect EXP from multiple evaluation. This may make a SAVE_EXPR. */
5090 tree
5092 tree exp;
5093 {
5096 /* If this has no side effects, we don't need to do anything. */
5100 /* If it is a conversion, protect what's inside the conversion.
5101 Similarly, if we're indirectly referencing something, we only
5102 actually need to protect the address since the data itself can't
5103 change in these situations. */
5112 /* If EXP is a fat pointer or something that can be placed into a register,
5113 just make a SAVE_EXPR. */
5117 /* Otherwise, dereference, protect the address, and re-reference. */
5118 else
5119 return
5123 exp)));
5124 }
5125 \f
5126 /* This is equivalent to stabilize_reference in GCC's tree.c, but we know
5127 how to handle our new nodes and we take an extra argument that says
5128 whether to force evaluation of everything. */
5130 tree
5132 tree ref;
5134 {
5140 {
5144 /* No action is needed in this case. */
5156 result
5165 force));
5171 force),
5179 force),
5181 force));
5188 force));
5195 force));
5201 force),
5203 force));
5212 /* If arg isn't a kind of lvalue we recognize, make no change.
5213 Caller should recognize the error for an invalid lvalue. */
5219 }
5223 }
5225 /* Similar to stabilize_reference_1 in tree.c, but supports an extra
5226 arg to force a SAVE_EXPR for everything. */
5228 static tree
5230 tree e;
5232 {
5237 /* We cannot ignore const expressions because it might be a reference
5238 to a const array but whose index contains side-effects. But we can
5239 ignore things that are actual constant or that already have been
5240 handled by this function. */
5246 {
5260 /* Constants need no processing. In fact, we should never reach
5261 here. */
5265 /* Recursively stabilize each operand. */
5272 /* Recursively stabilize each operand. */
5275 force));
5280 }
5284 }
5285 \f
5286 /* GNAT_UNIT is the Defining_Identifier for some package or subprogram,
5287 either a spec or a body, BODY_P says which. If needed, make a function
5288 to be the elaboration routine for that object and perform the elaborations
5289 in GNU_ELAB_LIST.
5291 Return 1 if we didn't need an elaboration function, zero otherwise. */
5293 static int
5295 Entity_Id gnat_unit;
5297 tree gnu_elab_list;
5298 {
5299 tree gnu_decl;
5300 rtx insn;
5303 /* If we have nothing to do, return. */
5307 /* Prevent the elaboration list from being reclaimed by the GC. */
5309 gnu_elab_list);
5311 /* Set our file and line number to that of the object and set up the
5312 elaboration routine. */
5314 body_p ?
5326 /* Emit the assignments for the elaborations we have to do. If there
5327 is no destination, this is just a call to execute some statement
5328 that was placed within the declarative region. But first save a
5329 pointer so we can see if any insns were generated. */
5335 {
5338 }
5339 else
5340 {
5346 /* If LHS has a padded type, convert it to the unpadded type
5347 so the assignment is done properly. */
5356 }
5358 /* See if any non-NOTE insns were generated. */
5361 {
5364 }
5371 /* We are finished with the elaboration list it can now be discarded. */
5374 /* If there were no insns, we don't need an elab routine. It would
5375 be nice to not output this one, but there's no good way to do that. */
5377 }
5378 \f
5381 /* Determine the input_filename and the lineno from the source location
5382 (Sloc) of GNAT_NODE node. Set the global variable input_filename and
5383 lineno. If WRITE_NOTE_P is true, emit a line number note. */
5385 void
5387 Node_Id gnat_node;
5389 {
5392 /* If node not from source code, ignore. */
5396 /* Use the identifier table to make a hashed, permanent copy of the filename,
5397 since the name table gets reallocated after Gigi returns but before all
5398 the debugging information is output. The call to
5399 __gnat_to_canonical_file_spec translates filenames from pragmas
5400 Source_Reference that contain host style syntax not understood by gdb. */
5401 input_filename
5402 = IDENTIFIER_POINTER
5403 (get_identifier
5404 (__gnat_to_canonical_file_spec
5405 (Get_Name_String
5408 /* ref_filename is the reference file name as given by sinput (i.e no
5409 directory) */
5410 ref_filename
5411 = IDENTIFIER_POINTER
5412 (get_identifier
5413 (Get_Name_String
5419 }
5420 \f
5421 /* Post an error message. MSG is the error message, properly annotated.
5422 NODE is the node at which to post the error and the node to use for the
5423 "&" substitution. */
5425 void
5428 Node_Id node;
5429 {
5430 String_Template temp;
5431 Fat_Pointer fp;
5437 }
5439 /* Similar, but NODE is the node at which to post the error and ENT
5440 is the node to use for the "&" substitution. */
5442 void
5445 Node_Id node;
5446 Entity_Id ent;
5447 {
5448 String_Template temp;
5449 Fat_Pointer fp;
5455 }
5457 /* Similar, but NODE is the node at which to post the error, ENT is the node
5458 to use for the "&" substitution, and N is the number to use for the ^. */
5460 void
5463 Node_Id node;
5464 Entity_Id ent;
5466 {
5467 String_Template temp;
5468 Fat_Pointer fp;
5476 }
5477 \f
5478 /* Similar to post_error_ne_num, but T is a GCC tree representing the
5479 number to write. If the tree represents a constant that fits within
5480 a host integer, the text inside curly brackets in MSG will be output
5481 (presumably including a '^'). Otherwise that text will not be output
5482 and the text inside square brackets will be output instead. */
5484 void
5487 Node_Id node;
5488 Entity_Id ent;
5489 tree t;
5490 {
5493 Fat_Pointer fp;
5501 #if HOST_BITS_PER_WIDE_INT > HOST_BITS_PER_INT
5503 #endif
5504 )
5505 {
5508 }
5509 else
5513 {
5519 ;
5520 else
5522 }
5529 }
5531 /* Similar to post_error_ne_tree, except that NUM is a second
5532 integer to write in the message. */
5534 void
5537 Node_Id node;
5538 Entity_Id ent;
5539 tree t;
5541 {
5544 }
5546 /* Set the node for a second '&' in the error message. */
5548 void
5550 Entity_Id e;
5551 {
5553 }
5554 \f
5555 /* Signal abort, with "Gigi abort" as the error label, and error_gnat_node
5556 as the relevant node that provides the location info for the error */
5558 void
5561 {
5563 Fat_Pointer fp;
5569 }
5570 \f
5571 /* Initialize the table that maps GNAT codes to GCC codes for simple
5572 binary and unary operations. */
5574 void
5576 {
5602 }