| blob | 7c376e5b2d8b9a3a50cd328f22b9da10a1a7855a |
1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * T R A N S *
6 * *
7 * C Implementation File *
8 * *
9 * $Revision: 1.10 $
10 * *
11 * Copyright (C) 1992-2001, Free Software Foundation, Inc. *
12 * *
13 * GNAT is free software; you can redistribute it and/or modify it under *
14 * terms of the GNU General Public License as published by the Free Soft- *
15 * ware Foundation; either version 2, or (at your option) any later ver- *
16 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
17 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
18 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
19 * for more details. You should have received a copy of the GNU General *
20 * Public License distributed with GNAT; see file COPYING. If not, write *
21 * to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
22 * MA 02111-1307, USA. *
23 * *
24 * GNAT was originally developed by the GNAT team at New York University. *
25 * It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
26 * *
27 ****************************************************************************/
67 /* Current filename without path. */
70 /* Flag indicating whether file names are discarded in exception messages */
73 /* If true, then gigi is being called on an analyzed but unexpanded
74 tree, and the only purpose of the call is to properly annotate
75 types with representation information. */
78 /* List of TREE_LIST nodes representing a block stack. TREE_VALUE
79 of each gives the variable used for the setjmp buffer in the current
80 block, if any. TREE_PURPOSE gives the bottom condition for a loop,
81 if this block is for a loop. The latter is only used to save the tree
82 over GC. */
83 tree gnu_block_stack;
85 /* List of TREE_LIST nodes representing a stack of exception pointer
86 variables. TREE_VALUE is the VAR_DECL that stores the address of
87 the raised exception. Nonzero means we are in an exception
88 handler. Set to error_mark_node in the zero-cost case. */
91 /* Map GNAT tree codes to GCC tree codes for simple expressions. */
94 /* Current node being treated, in case gigi_abort called. */
95 Node_Id error_gnat_node;
97 /* Variable that stores a list of labels to be used as a goto target instead of
98 a return in some functions. See processing for N_Subprogram_Body. */
122 /* Constants for +0.5 and -0.5 for float-to-integer rounding. */
125 \f
126 /* This is the main program of the back-end. It sets up all the table
127 structures and then generates code. */
129 void
135 gigi_operating_mode)
137 Node_Id gnat_root;
149 Int number_units ATTRIBUTE_UNUSED;
152 Entity_Id standard_integer;
153 Entity_Id standard_long_long_float;
154 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. */
205 gnu_standard_long_long_float
207 gnu_standard_exception_type
212 /* Emit global symbols containing context list info for the SGI Workshop
213 debugger */
215 #ifdef MIPS_DEBUGGING_INFO
221 #endif
223 #ifdef ASM_OUTPUT_IDENT
225 ASM_OUTPUT_IDENT
228 #endif
231 }
233 \f
234 /* This function is the driver of the GNAT to GCC tree transformation process.
235 GNAT_NODE is the root of some gnat tree. It generates code for that
236 part of the tree. */
238 void
240 Node_Id gnat_node;
241 {
242 tree gnu_root;
244 /* Save node number in case error */
249 /* This should just generate code, not return a value. If it returns
250 a value, something is wrong. */
253 }
255 /* GNAT_NODE is the root of some GNAT tree. Return the root of the GCC
256 tree corresponding to that GNAT tree. Normally, no code is generated.
257 We just return an equivalent tree which is used elsewhere to generate
258 code. */
260 tree
262 Node_Id gnat_node;
263 {
264 tree gnu_root;
266 /* Save node number in case error */
271 /* If we got no code as a result, something is wrong. */
276 }
277 \f
278 /* This function is the driver of the GNAT to GCC tree transformation process.
279 It is the entry point of the tree transformer. GNAT_NODE is the root of
280 some GNAT tree. Return the root of the corresponding GCC tree or
281 error_mark_node to signal that there is no GCC tree to return.
283 The latter is the case if only code generation actions have to be performed
284 like in the case of if statements, loops, etc. This routine is wrapped
285 in the above two routines for most purposes. */
287 static tree
289 Node_Id gnat_node;
290 {
293 tree gnu_expr;
295 Node_Id gnat_temp;
296 Entity_Id gnat_temp_type;
298 /* Set input_file_name and lineno from the Sloc in the GNAT tree. */
301 /* If this is a Statement and we are at top level, we add the statement
302 as an elaboration for a null tree. That will cause it to be placed
303 in the elaboration procedure. */
316 {
320 }
322 /* If this node is a non-static subexpression and we are only
323 annotating types, make this into a NULL_EXPR for non-VOID types
324 and error_mark_node for void return types. But allow
325 N_Identifier since we use it for lots of things, including
326 getting trees for discriminants. */
332 {
337 else
340 }
343 {
344 /********************************/
345 /* Chapter 2: Lexical Elements: */
346 /********************************/
353 /* If the Etype of this node does not equal the Etype of the
354 Entity, something is wrong with the entity map, probably in
355 generic instantiation. However, this does not apply to
356 types. Since we sometime have strange Ekind's, just do
357 this test for objects. Also, if the Etype of the Entity
358 is private, the Etype of the N_Identifier is allowed to be the
359 full type and also we consider a packed array type to be the
360 same as the original type. Finally, if the types are Itypes,
361 one may be a copy of the other, which is also legal. */
384 /* If this is a reference to a deferred constant whose partial view
385 is an unconstrained private type, the proper type is on the full
386 view of the constant, not on the full view of the type, which may
387 be unconstrained.
389 This may be a reference to a type, for example in the prefix of the
390 attribute Position, generated for dispatching code (see Make_DT in
391 exp_disp,adb). In that case we need the type itself, not is parent,
392 in particular if it is a derived type */
398 {
402 }
403 else
404 {
405 /* Expand the type of this identitier first, in case it is
406 an enumeral literal, which only get made when the type
407 is expanded. There is no order-of-elaboration issue here.
408 We want to use the Actual_Subtype if it has already been
409 elaborated, otherwise the Etype. Avoid using Actual_Subtype
410 for packed arrays to simplify things. */
418 else
422 }
426 /* If we are in an exception handler, force this variable into memory
427 to ensure optimization does not remove stores that appear
428 redundant but are actually needed in case an exception occurs.
430 ??? Note that we need not do this if the variable is declared within
431 the handler, only if it is referenced in the handler and declared
432 in an enclosing block, but we have no way of testing that
433 right now. */
435 {
438 }
440 /* Some objects (such as parameters passed by reference, globals of
441 variable size, and renamed objects) actually represent the address
442 of the object. In that case, we must do the dereference. Likewise,
443 deal with parameters to foreign convention subprograms. Call fold
444 here since GNU_RESULT may be a CONST_DECL. */
448 {
453 gnu_result);
458 }
460 /* The GNAT tree has the type of a function as the type of its result.
461 Also use the type of the result if the Etype is a subtype which
462 is nominally unconstrained. But remove any padding from the
463 resulting type. */
466 {
471 }
473 /* We always want to return the underlying INTEGER_CST for an
474 enumeration literal to avoid the need to call fold in lots
475 of places. But don't do this is the parent will be taking
476 the address of this object. */
478 {
492 }
496 {
497 tree gnu_type;
499 /* Get the type of the result, looking inside any padding and
500 left-justified modular types. Then get the value in that type. */
508 /* Get the type of the result, looking inside any padding and
509 left-justified modular types. Then get the value in that type. */
518 /* If the result overflows (meaning it doesn't fit in its base type)
519 or is outside of the range of the subtype, we have an illegal tree
520 entry, so abort. Note that the test for of types with biased
521 representation is harder, so we don't test in that case. */
530 gnu_result)))
532 }
536 /* If a Entity is present, it means that this was one of the
537 literals in a user-defined character type. In that case,
538 just return the value in the CONST_DECL. Otherwise, use the
539 character code. In that case, the base type should be an
540 INTEGER_TYPE, but we won't bother checking for that. */
544 else
550 /* If this is of a fixed-point type, the value we want is the
551 value of the corresponding integer. */
553 {
556 gnu_result_type);
558 #if 0
564 gnu_result))
565 #endif
566 )
568 }
569 /* We should never see a Vax_Float type literal, since the front end
570 is supposed to transform these using appropriate conversions */
574 else
575 {
580 /* If the real value is zero, so is the result. Otherwise,
581 convert it to a machine number if it isn't already. That
582 forces BASE to 0 or 2 and simplifies the rest of our logic. */
585 else
586 {
588 ur_realval
592 gnu_result
595 /* If we have a base of zero, divide by the denominator.
596 Otherwise, the base must be 2 and we scale the value, which
597 we know can fit in the mantissa of the type (hence the use
598 of that type above). */
600 gnu_result
603 gnu_result,
605 gnu_result_type));
609 else
610 gnu_result
612 REAL_VALUE_LDEXP
615 }
617 /* Now see if we need to negate the result. Do it this way to
618 properly handle -0. */
620 gnu_result
622 gnu_result);
623 }
630 {
631 /* We assume here that all strings are of type standard.string.
632 "Weird" types of string have been converted to an aggregate
633 by the expander. */
639 /* Build the string with the characters in the literal. Note
640 that Ada strings are 1-origin. */
644 /* Put a null at the end of the string in case it's in a context
645 where GCC will want to treat it as a C string. */
650 /* Strings in GCC don't normally have types, but we want
651 this to not be converted to the array type. */
653 }
654 else
655 {
656 /* Build a list consisting of each character, then make
657 the aggregate. */
664 gnu_list
670 gnu_list);
672 gnu_result
674 }
681 /* Check for (and ignore) unrecognized pragma */
686 {
688 /* Do nothing at top level: all such variables are already
689 viewable. */
697 {
705 }
711 {
725 }
732 }
735 /**************************************/
736 /* Chapter 3: Declarations and Types: */
737 /**************************************/
752 /* If we are just annotating types and this object has an unconstrained
753 or task type, don't elaborate it. */
764 && (! type_annotate_only
766 {
771 /* If this object has its elaboration delayed, we must force
772 evaluation of GNU_EXPR right now and save it for when the object
773 is frozen. */
775 {
778 gnu_expr
782 else
786 }
787 }
788 else
803 /* Don't do anything if this renaming handled by the front end.
804 or if we are just annotating types and this object has an
805 unconstrained or task type, don't elaborate it. */
807 && ! (type_annotate_only
812 {
815 }
826 /* These are fully handled in the front end. */
829 /*************************************/
830 /* Chapter 4: Names and Expressions: */
831 /*************************************/
837 /* Emit access check if necessary */
845 {
847 tree gnu_type;
852 /* Emit access check if necessary */
859 /* If we got a padded type, remove it too. */
862 gnu_array_object
864 gnu_array_object);
868 /* First compute the number of dimensions of the array, then
869 fill the expression array, the order depending on whether
870 this is a Convention_Fortran array or not. */
875 ;
884 else
892 {
900 gnu_expr
901 = emit_index_check
908 }
909 }
915 {
916 tree gnu_type;
922 /* Emit access check if necessary */
926 /* Do any implicit dereferences of the prefix and do any needed
927 range check. */
932 {
933 /* Get the bounds of the slice. */
934 tree gnu_index_type
940 /* Check to see that the minimum slice value is in range */
941 gnu_expr_l
942 = emit_index_check
947 /* Check to see that the maximum slice value is in range */
948 gnu_expr_h
949 = emit_index_check
954 /* Derive a good type to convert everything too */
957 /* Build a compound expression that does the range checks */
958 gnu_expr
963 /* Build a conditional expression that returns the range checks
964 expression if the slice range is not null (max >= min) or
965 returns the min if the slice range is null */
966 gnu_expr
970 gnu_max_expr),
972 gnu_min_expr)),
974 }
975 else
980 }
984 {
988 tree gnu_field;
992 {
997 }
1004 /* For discriminant references in tagged types always substitute the
1005 corresponding discriminant as the actual selected component. */
1011 /* For discriminant references of untagged types always substitute the
1012 corresponding girder discriminant. */
1017 /* Handle extracting the real or imaginary part of a complex.
1018 The real part is the first field and the imaginary the last. */
1024 else
1025 {
1028 /* If there are discriminants, the prefix might be
1029 evaluated more than once, which is a problem if it has
1030 side-effects. */
1039 /* Emit discriminant check if necessary. */
1042 gnu_result
1044 }
1050 }
1054 {
1055 /* The attribute designator (like an enumeration value). */
1058 tree gnu_prefix;
1059 tree gnu_type;
1061 /* The Elab_Spec and Elab_Body attributes are special in that
1062 Prefix is a unit, not an object with a GCC equivalent. Similarly
1063 for Elaborated, since that variable isn't otherwise known. */
1065 {
1066 gnu_prefix
1067 = create_subprog_decl
1069 attribute == Attr_Elab_Body
1073 }
1078 /* If the input is a NULL_EXPR, make a new one. */
1080 {
1085 }
1088 {
1091 /* These are just conversions until since representation
1092 clauses for enumerations are handled in the front end. */
1093 {
1100 }
1105 /* These just add or subject the constant 1. Representation
1106 clauses for enumerations are handled in the front-end. */
1111 {
1113 gnu_expr
1114 = emit_check
1116 gnu_expr,
1117 attribute == Attr_Pred
1120 gnu_expr);
1121 }
1123 gnu_result
1133 /* Conversions don't change something's address but can cause
1134 us to miss the COMPONENT_REF case below, so strip them off. */
1137 /* If we are taking 'Address of an unconstrained object,
1138 this is the pointer to the underlying array. */
1141 /* ... fall through ... */
1148 gnu_result
1154 /* For 'Code_Address, find an inner ADDR_EXPR and mark it
1155 so that we don't try to build a trampoline. */
1157 {
1163 ;
1167 }
1178 /* Remove NOPS from gnu_expr and conversions from gnu_prefix.
1179 We only use GNU_EXPR to see if a COMPONENT_REF was involved. */
1187 /* Replace an unconstrained array type with the type of the
1188 underlying array. We can't do this with a call to
1189 maybe_unconstrained_array since we may have a TYPE_DECL.
1190 For 'Max_Size_In_Storage_Elements, use the record type
1191 that will be used to allocate the object and its template. */
1194 {
1198 }
1200 /* If we are looking for the size of a field, return the
1201 field size. Otherwise, if the prefix is an object,
1202 or if 'Object_Size or 'Max_Size_In_Storage_Elements has
1203 been specified, the result is the GCC size of the type.
1204 Otherwise, the result is the RM_Size of the type. */
1210 {
1211 /* If this is a padded type, the GCC size isn't relevant
1212 to the programmer. Normally, what we want is the RM_Size,
1213 which was set from the specified size, but if it was not
1214 set, we want the size of the relevant field. Using the MAX
1215 of those two produces the right result in all case. Don't
1216 use the size of the field if it's a self-referential type,
1217 since that's never what's wanted. */
1221 {
1225 gnu_result
1228 }
1229 else
1231 }
1232 else
1238 /* Deal with a self-referential size by returning the maximum
1239 size for a type and by qualifying the size with
1240 the object for 'Size of an object. */
1244 {
1248 else
1250 }
1252 /* If the type contains a template, subtract the size of the
1253 template. */
1259 /* If the type contains a template, subtract the size of the
1260 template. */
1268 /* Always perform division using unsigned arithmetic as the
1269 size cannot be negative, but may be an overflowed positive
1270 value. This provides correct results for sizes up to 512 MB.
1271 ??? Size should be calculated in storage elements directly. */
1276 gnu_result,
1277 bitsize_unit_node)));
1284 && (TYPE_IS_PADDING_P
1293 gnu_result
1295 else
1306 {
1313 else
1314 gnu_result
1315 = build_binary_op
1317 build_binary_op
1329 }
1330 /* ... fall through ... */
1332 {
1333 int Dimension
1338 /* Emit access check if necessary */
1342 /* Make sure any implicit dereference gets done. */
1350 {
1352 tree gnu_type_temp;
1358 ;
1361 }
1370 gnu_result
1373 gnu_result
1375 else
1376 /* 'Length or 'Range_Length. */
1377 {
1378 tree gnu_compute_type
1379 = signed_or_unsigned_type
1382 gnu_result
1383 = build_binary_op
1385 build_binary_op
1387 build_binary_op
1390 TYPE_MAX_VALUE
1393 TYPE_MIN_VALUE
1397 }
1399 /* If this has a PLACEHOLDER_EXPR, qualify it by the object
1400 we are handling. Note that these attributes could not
1401 have been used on an unconstrained array type. */
1408 }
1415 {
1416 HOST_WIDE_INT bitsize;
1417 HOST_WIDE_INT bitpos;
1418 tree gnu_offset;
1419 tree gnu_field_bitpos;
1420 tree gnu_field_offset;
1421 tree gnu_inner;
1429 /* We can have 'Bit on any object, but if it isn't a
1430 COMPONENT_REF, the result is zero. Do not allow
1431 'Bit on a bare component, though. */
1435 {
1438 }
1450 {
1451 gnu_field_bitpos
1453 gnu_field_offset
1460 {
1461 gnu_field_bitpos
1465 gnu_field_offset
1469 }
1470 }
1472 {
1475 }
1476 else
1477 {
1480 }
1483 {
1497 gnu_result
1501 bitsize_one_node);
1507 }
1509 /* If this has a PLACEHOLDER_EXPR, qualify it by the object
1510 we are handling. */
1517 }
1540 && (TYPE_IS_PADDING_P
1548 gnu_type
1558 /* Note this size cannot be self-referential. */
1565 /* This is just a zero cast to the pointer type for
1566 our prefix and dereferenced. */
1568 gnu_result
1571 integer_zero_node));
1576 {
1583 {
1588 ;
1589 }
1595 || (DECL_BY_COMPONENT_PTR_P
1599 }
1603 /* Say we have an unimplemented attribute. Then set the
1604 value to be returned to be a zero and hope that's something
1605 we can convert to the type of this attribute. */
1611 }
1613 /* If this is an attribute where the prefix was unused,
1614 force a use of it if it has a side-effect. */
1618 }
1622 /* Like 'Access as far as we are concerned. */
1630 {
1631 tree gnu_aggr_type;
1633 /* ??? It is wrong to evaluate the type now, but there doesn't
1634 seem to be any other practical way of doing it. */
1636 gnu_aggr_type = gnu_result_type
1641 gnu_aggr_type
1648 gnu_result
1650 gnu_aggr_type);
1652 {
1653 /* The first element is the discrimant, which we ignore. The
1654 next is the field we're building. Convert the expression
1655 to the type of the field and then to the union type. */
1656 Node_Id gnat_assoc
1659 tree gnu_field_type
1664 }
1667 gnu_aggr_type,
1670 gnu_result
1671 = build_binary_op
1676 (Next
1678 else
1682 }
1692 /* Get the operand expression. */
1696 gnu_result
1708 /* If the result is a pointer type, see if we are improperly
1709 converting to a stricter alignment. */
1713 {
1716 unsigned int oalign
1721 post_error_ne_tree_2
1725 }
1732 {
1735 tree gnu_low;
1736 tree gnu_high;
1738 /* GNAT_RANGE is either an N_Range node or an identifier
1739 denoting a subtype. */
1741 {
1744 }
1747 {
1752 }
1753 else
1758 /* If LOW and HIGH are identical, perform an equality test.
1759 Otherwise, ensure that GNU_OBJECT is only evaluated once
1760 and perform a full range test. */
1764 else
1765 {
1767 gnu_result
1773 }
1777 }
1785 ? RDIV_EXPR
1792 {
1794 tree gnu_rhs_side;
1796 /* The elaboration of the RHS may generate code. If so,
1797 we need to make sure it gets executed after the LHS. */
1807 gnu_rhs);
1810 }
1814 /* These can either be operations on booleans or on modular types.
1815 Fall through for boolean types since that's the way GNU_CODES is
1816 set up. */
1818 Modular_Integer_Kind))
1819 {
1820 enum tree_code code
1831 }
1833 /* ... fall through ... */
1844 {
1846 tree gnu_type;
1852 /* If this is a comparison operator, convert any references to
1853 an unconstrained array value into a reference to the
1854 actual array. */
1856 {
1859 }
1861 /* If the result type is a private type, its full view may be a
1862 numeric subtype. The representation we need is that of its base
1863 type, given that it is the result of an arithmetic operation. */
1865 gnu_type = gnu_result_type
1868 /* If this is a shift whose count is not guaranteed to be correct,
1869 we need to adjust the shift count. */
1872 {
1874 tree gnu_max_shift
1882 gnu_rhs
1883 = build_binary_op
1886 gnu_count_type,
1887 gnu_max_shift,
1889 integer_one_node)),
1890 gnu_rhs);
1891 }
1893 /* For right shifts, the type says what kind of shift to do,
1894 so we may need to choose a different type. */
1903 {
1906 }
1910 /* If this is a logical shift with the shift count not verified,
1911 we must return zero if it is too large. We cannot compensate
1912 above in this case. */
1916 gnu_result
1917 = build_cond_expr
1920 gnu_rhs,
1924 gnu_result);
1925 }
1929 {
1932 tree gnu_false
1939 }
1948 /* This case can apply to a boolean or a modular type.
1949 Fall through for a boolean operand since GNU_CODES is set
1950 up to handle this. */
1952 {
1956 gnu_expr);
1958 }
1960 /* ... fall through ... */
1967 else
1976 {
1978 tree gnu_type;
1982 /* The Expression operand can either be an N_Identifier or
1983 Expanded_Name, which must represent a type, or a
1984 N_Qualified_Expression, which contains both the object type and an
1985 initial value for the object. */
1990 {
1991 Entity_Id gnat_desig_type
2002 {
2005 }
2006 else
2007 {
2013 }
2014 }
2015 else
2022 }
2025 /***************************/
2026 /* Chapter 5: Statements: */
2027 /***************************/
2031 {
2037 /* If this is the first label of an exception handler, we must
2038 mark that any CALL_INSN can jump to it. */
2042 nonlocal_goto_handler_labels
2044 nonlocal_goto_handler_labels);
2045 }
2055 /* Get the LHS and RHS of the statement and convert any reference to an
2056 unconstrained array into a reference to the underlying array. */
2058 gnu_rhs
2063 /* If range check is needed, emit code to generate it */
2067 /* If either side's type has a size that overflows, convert this
2068 into raise of Storage_Error: execution shouldn't have gotten
2069 here anyway. */
2075 else
2081 /* Start an IF statement giving the condition. */
2086 /* Generate code for the statements to be executed if the condition
2087 is true. */
2094 /* Generate each of the "else if" parts. */
2096 {
2100 {
2101 Node_Id gnat_statement;
2105 /* Set up the line numbers for each condition we test. */
2113 }
2114 }
2116 /* Finally, handle any statements in the "else" part. */
2118 {
2125 }
2131 {
2132 Node_Id gnat_when;
2133 Node_Id gnat_choice;
2134 tree gnu_label;
2135 Node_Id gnat_statement;
2146 {
2147 /* First compile all the different case choices for the current
2148 WHEN alternative. */
2152 {
2159 {
2161 /* Abort on all errors except range empty, which
2162 means we ignore this alternative. */
2163 error_code
2173 error_code
2174 = pushcase_range
2187 /* This represents either a subtype range or a static value
2188 of some kind; Ekind says which. If a static value,
2189 fall through to the next case. */
2191 {
2194 error_code
2202 }
2203 /* ... fall through ... */
2218 }
2219 }
2221 /* After compiling the choices attached to the WHEN compile the
2222 body of statements that have to be executed, should the
2223 "WHEN ... =>" be taken. */
2229 /* Communicate to GCC that we are done with the current WHEN,
2230 i.e. insert a "break" statement. */
2232 }
2235 }
2239 {
2240 /* The loop variable in GCC form, if any. */
2242 /* PREINCREMENT_EXPR or PREDECREMENT_EXPR. */
2244 /* Used if this is a named loop for so EXIT can work. */
2246 /* Condition to continue loop tested at top of loop. */
2248 /* Similar, but tested at bottom of loop. */
2250 Node_Id gnat_statement;
2255 /* Set the condition that under which the loop should continue.
2256 For "LOOP .... END LOOP;" the condition is always true. */
2258 ;
2259 /* The case "WHILE condition LOOP ..... END LOOP;" */
2262 else
2263 {
2264 /* We have an iteration scheme. */
2265 Node_Id gnat_loop_spec
2277 tree gnu_limit
2281 /* We know the loop variable will not overflow if GNU_LAST is
2282 a constant and is not equal to GNU_LIMIT. If it might
2283 overflow, we have to move the limit test to the end of
2284 the loop. In that case, we have to test for an
2285 empty loop outside the loop. */
2289 {
2295 }
2297 /* Open a new nesting level that will surround the loop to declare
2298 the loop index variable. */
2302 /* Declare the loop index and set it to its initial value. */
2306 gnu_loop_var);
2308 /* The loop variable might be a padded type, so use `convert' to
2309 get a reference to the inner variable if so. */
2312 /* Set either the top or bottom exit condition as
2313 appropriate depending on whether we know an overflow
2314 cannot occur or not. */
2316 gnu_bottom_condition
2319 else
2320 gnu_top_condition
2325 }
2330 else
2333 /* If the loop was named, have the name point to this loop. In this
2334 case, the association is not a ..._DECL node; in fact, it isn't
2335 a GCC tree node at all. Since this name is referenced inside
2336 the loop, do it before we process the statements of the loop. */
2338 {
2343 }
2347 /* We must evaluate the condition after we've entered the
2348 loop so that any expression actions get done in the right
2349 place. */
2355 /* Make the loop body into its own block, so any allocated
2356 storage will be released every iteration. This is needed
2357 for stack allocation. */
2360 gnu_block_stack
2377 {
2380 gnu_loop_var,
2382 integer_one_node));
2385 }
2391 {
2392 /* Close the nesting level that sourround the loop that was used to
2393 declare the loop index variable. */
2397 }
2400 {
2403 }
2404 }
2421 {
2422 /* Which loop to exit, NULL if the current loop. */
2424 /* The GCC version of the optional GNAT condition node attached to the
2425 exit statement. Exit the loop if this is false. */
2429 loop_id
2434 gnu_cond
2435 = invert_truthvalue
2440 }
2447 {
2448 /* The gnu function type of the subprogram currently processed. */
2450 /* The return value from the subprogram. */
2453 /* If we are dealing with a "return;" from an Ada procedure with
2454 parameters passed by copy in copy out, we need to return a record
2455 containing the final values of these parameters. If the list
2456 contains only one entry, return just that entry.
2458 For a full description of the copy in copy out parameter mechanism,
2459 see the part of the gnat_to_gnu_entity routine dealing with the
2460 translation of subprograms.
2462 But if we have a return label defined, convert this into
2463 a branch to that label. */
2469 {
2472 else
2473 gnu_ret_val
2476 }
2478 /* If the Ada subprogram is a function, we just need to return the
2479 expression. If the subprogram returns an unconstrained
2480 array, we have to allocate a new version of the result and
2481 return it. If we return by reference, return a pointer. */
2484 {
2487 /* Do not remove the padding from GNU_RET_VAL if the inner
2488 type is self-referential since we want to allocate the fixed
2489 size in that case. */
2491 && (TYPE_IS_PADDING_P
2493 && contains_placeholder_p
2502 {
2505 /* We have two cases: either the function returns with
2506 depressed stack or not. If not, we allocate on the
2507 secondary stack. If so, we allocate in the stack frame.
2508 if no copy is needed, the front end will set By_Ref,
2509 which we handle in the case above. */
2511 gnu_ret_val
2514 else
2515 gnu_ret_val
2520 }
2521 }
2527 gnu_ret_val));
2528 else
2531 }
2544 /****************************/
2545 /* Chapter 6: Subprograms: */
2546 /****************************/
2549 /* Unless there is a freeze node, declare the subprogram. We consider
2550 this a "definition" even though we're not generating code for
2551 the subprogram because we will be making the corresponding GCC
2552 node here. */
2561 /* This subprogram doesn't exist for code generation purposes, but we
2562 have to elaborate the types of any parameters, unless they are
2563 imported types (nothing to generate in this case). */
2575 /* For a child unit identifier go up a level to get the
2576 specificaton. We get this when we try to find the spec of
2577 a child unit package that is the compilation unit being compiled. */
2582 {
2583 /* Save debug output mode in case it is reset. */
2586 /* Definining identifier of a parameter to the subprogram. */
2587 Entity_Id gnat_param;
2588 /* The defining identifier for the subprogram body. Note that if a
2589 specification has appeared before for this body, then the identifier
2590 occurring in that specification will also be a defining identifier
2591 and all the calls to this subprogram will point to that
2592 specification. */
2593 Entity_Id gnat_subprog_id
2597 /* The FUNCTION_DECL node corresponding to the subprogram spec. */
2598 tree gnu_subprog_decl;
2599 /* The FUNCTION_TYPE node corresponding to the subprogram spec. */
2600 tree gnu_subprog_type;
2601 tree gnu_cico_list;
2603 /* If this is a generic object or if it has been eliminated,
2604 ignore it. */
2611 /* If debug information is suppressed for the subprogram,
2612 turn debug mode off for the duration of processing. */
2614 {
2617 }
2619 /* If this subprogram acts as its own spec, define it. Otherwise,
2620 just get the already-elaborated tree node. However, if this
2621 subprogram had its elaboration deferred, we will already have
2622 made a tree node for it. So treat it as not being defined in
2623 that case. Such a subprogram cannot have an address clause or
2624 a freeze node, so this test is safe, though it does disable
2625 some otherwise-useful error checking. */
2626 gnu_subprog_decl
2633 /* Set the line number in the decl to correspond to that of
2634 the body so that the line number notes are written
2635 correctly. */
2649 /* If there are OUT parameters, we need to ensure that the
2650 return statement properly copies them out. We do this by
2651 making a new block and converting any inner return into a goto
2652 to a label at the end of the block. */
2655 {
2656 gnu_return_label_stack
2659 gnu_return_label_stack);
2662 }
2663 else
2664 gnu_return_label_stack
2667 /* See if there are any parameters for which we don't yet have
2668 GCC entities. These must be for OUT parameters for which we
2669 will be making VAR_DECL nodes here. Fill them in to
2670 TYPE_CI_CO_LIST, which must contain the empty entry as well.
2671 We can match up the entries because TYPE_CI_CO_LIST is in the
2672 order of the parameters. */
2679 else
2680 {
2681 /* Skip any entries that have been already filled in; they
2682 must correspond to IN OUT parameters. */
2685 ;
2687 /* Do any needed references for padded types. */
2691 }
2695 /* Generate the code of the subprogram itself. A return statement
2696 will be present and any OUT parameters will be handled there. */
2704 {
2705 tree gnu_retval;
2715 else
2717 gnu_cico_list);
2720 gnu_retval
2723 expand_return
2726 gnu_retval));
2728 }
2732 /* Disconnect the trees for parameters that we made variables for
2733 from the GNAT entities since these will become unusable after
2734 we end the function. */
2745 }
2754 {
2755 /* The GCC node corresponding to the GNAT subprogram name. This can
2756 either be a FUNCTION_DECL node if we are dealing with a standard
2757 subprogram call, or an indirect reference expression (an
2758 INDIRECT_REF node) pointing to a subprogram. */
2760 /* The FUNCTION_TYPE node giving the GCC type of the subprogram. */
2762 tree gnu_subprog_addr
2764 Entity_Id gnat_formal;
2765 Node_Id gnat_actual;
2769 tree gnu_subprog_call;
2772 {
2780 }
2785 /* If we are calling a stubbed function, make this into a
2786 raise of Program_Error. Elaborate all our args first. */
2790 {
2797 {
2799 gnu_result
2802 }
2803 else
2806 }
2808 /* The only way we can be making a call via an access type is
2809 if Name is an explicit dereference. In that case, get the
2810 list of formal args from the type the access type is pointing
2811 to. Otherwise, get the formals from entity being called. */
2815 /* Assume here that this must be 'Elab_Body or 'Elab_Spec. */
2817 else
2820 /* Create the list of the actual parameters as GCC expects it, namely
2821 a chain of TREE_LIST nodes in which the TREE_VALUE field of each
2822 node is a parameter-expression and the TREE_PURPOSE field is
2823 null. Skip OUT parameters that are not passed by reference. */
2829 {
2831 Node_Id gnat_name
2836 tree gnu_actual;
2838 /* If it's possible we may need to use this expression twice,
2839 make sure than any side-effects are handled via SAVE_EXPRs.
2840 Likewise if we need to force side-effects before the call.
2841 ??? This is more conservative than we need since we don't
2842 need to do this for pass-by-ref with no conversion.
2843 If we are passing a non-addressable Out or In Out parameter by
2844 reference, pass the address of a copy and set up to copy back
2845 out after the call. */
2848 {
2855 {
2858 /* Remove any unpadding on the actual and make a copy.
2859 But if the actual is a left-justified modular type,
2860 first convert to it. */
2862 && (TYPE_IS_PADDING_P
2866 && (TYPE_LEFT_JUSTIFIED_MODULAR_P
2872 /* Set up to move the copy back to the original. */
2874 gnu_after_list);
2877 }
2878 }
2880 /* If this was a procedure call, we may not have removed any
2881 padding. So do it here for the part we will use as an
2882 input, if any. */
2888 gnu_actual);
2895 /* Do any needed conversions. We need only check for
2896 unchecked conversion since normal conversions will be handled
2897 by just converting to the formal type. */
2899 {
2900 gnu_actual
2902 gnu_actual);
2904 /* One we've done the unchecked conversion, we still
2905 must ensure that the object is in range of the formal's
2906 type. */
2911 }
2912 else
2913 /* We may have suppressed a conversion to the Etype of the
2914 actual since the parent is a procedure call. So add the
2915 conversion here. */
2917 gnu_actual);
2921 /* If we have not saved a GCC object for the formal, it means
2922 it is an OUT parameter not passed by reference. Otherwise,
2923 look at the PARM_DECL to see if it is passed by reference. */
2927 {
2929 {
2932 /* If we have a padded type, be sure we've removed the
2933 padding. */
2936 gnu_actual
2938 gnu_actual);
2939 }
2941 /* The symmetry of the paths to the type of an entity is
2942 broken here since arguments don't know that they will
2943 be passed by ref. */
2946 gnu_actual);
2947 }
2951 {
2958 {
2959 gnu_formal_type
2962 }
2964 /* Take the address of the object and convert to the
2965 proper pointer type. We'd like to actually compute
2966 the address of the beginning of the array using
2967 an ADDR_EXPR of an ARRAY_REF, but there's a possibility
2968 that the ARRAY_REF might return a constant and we'd
2969 be getting the wrong address. Neither approach is
2970 exactly correct, but this is the most likely to work
2971 in all cases. */
2974 gnu_actual));
2975 }
2979 {
2980 /* If arg is 'Null_Parameter, pass zero descriptor. */
2984 gnu_actual
2986 integer_zero_node);
2987 else
2988 gnu_actual
2991 gnat_formal));
2992 }
2993 else
2994 {
2998 gnu_name_list
3006 /* If this is 'Null_Parameter, pass a zero even though we are
3007 dereferencing it. */
3012 BITS_PER_WORD))
3013 gnu_actual
3014 = unchecked_convert
3018 integer_zero_node));
3019 else
3020 gnu_actual
3023 gnu_actual);
3024 }
3026 gnu_actual_list
3029 }
3033 NULL_TREE);
3036 /* If it is a function call, the result is the call expression. */
3038 {
3041 /* If the function returns an unconstrained array or by reference,
3042 we have to de-dereference the pointer. */
3046 gnu_result);
3049 }
3051 /* If this is the case where the GNAT tree contains a procedure call
3052 but the Ada procedure has copy in copy out parameters, the special
3053 parameter passing mechanism must be used. */
3055 {
3056 /* List of FIELD_DECLs associated with the PARM_DECLs of the copy
3057 in copy out parameters. */
3062 {
3063 tree gnu_name;
3067 /* If any of the names had side-effects, ensure they are
3068 all evaluated before the call. */
3072 gnu_subprog_call
3075 }
3079 else
3086 /* If we are dealing with a copy in copy out parameter, we must
3087 retrieve its value from the record returned in the function
3088 call. */
3092 || (DECL_BY_COMPONENT_PTR_P
3096 {
3097 /* Get the value to assign to this OUT or IN OUT
3098 parameter. It is either the result of the function if
3099 there is only a single such parameter or the appropriate
3100 field from the record returned. */
3101 tree gnu_result
3103 : build_component_ref
3106 int unchecked_conversion
3108 /* If the actual is a conversion, get the inner expression,
3109 which will be the real destination, and convert the
3110 result to the type of the actual parameter. */
3111 tree gnu_actual
3114 /* If the result is a padded type, remove the padding. */
3117 gnu_result
3120 gnu_result);
3122 /* If the result is a type conversion, do it. */
3124 gnu_result
3125 = convert_with_check
3132 gnu_result
3134 else
3135 {
3145 gnu_result);
3146 }
3153 }
3154 }
3155 else
3156 {
3159 }
3161 /* Handle anything we need to assign back. */
3163 gnu_expr;
3168 }
3171 /*************************/
3172 /* Chapter 7: Packages: */
3173 /*************************/
3187 /* If this is the body of a generic package - do nothing */
3194 {
3198 }
3201 /*********************************/
3202 /* Chapter 8: Visibility Rules: */
3203 /*********************************/
3207 /* Nothing to do here - but these may appear in list of declarations */
3210 /***********************/
3211 /* Chapter 9: Tasks: */
3212 /***********************/
3221 /***********************************************************/
3222 /* Chapter 10: Program Structure and Compilation Issues: */
3223 /***********************************************************/
3227 /* For a body, first process the spec if there is one. */
3236 {
3243 };
3250 /* Process any pragmas following the unit. */
3256 /* Put all the Actions into the elaboration routine if we already had
3257 elaborations. This will happen anyway if they are statements, but we
3258 want to force declarations there too due to order-of-elaboration
3259 issues. Most should have Is_Statically_Allocated set. If we
3260 have had no elaborations, we have no order-of-elaboration issue and
3261 don't want to create elaborations here. */
3265 {
3269 else
3271 }
3273 /* Generate elaboration code for this unit, if necessary, and
3274 say whether we did or not. */
3275 Set_Has_No_Elaboration_Code
3277 build_unit_elab
3289 /* Simply process whatever unit is being inserted. */
3297 /***************************/
3298 /* Chapter 11: Exceptions: */
3299 /***************************/
3302 /* If there are exception handlers, start a new binding level that
3303 we can exit (since each exception handler will do so). Then
3304 declare a variable to save the old __gnat_jmpbuf value and a
3305 variable for our jmpbuf. Call setjmp and handle each of the
3306 possible exceptions if it returns one. */
3309 {
3313 tree gnu_cleanup_decl;
3319 {
3320 gnu_jmpsave_decl
3322 jmpbuf_ptr_type,
3331 }
3333 /* See if we are to call a function when exiting this block. */
3335 {
3336 gnu_cleanup_call
3339 gnu_cleanup_decl
3345 }
3348 {
3349 /* When we exit this block, restore the saved value. */
3352 gnu_jmpsave_decl));
3354 /* Call setjmp and handle exceptions if it returns one. */
3356 expand_start_cond
3359 gnu_jmpbuf_decl)),
3362 /* Restore our incoming longjmp value before we do anything. */
3364 gnu_jmpsave_decl));
3369 gnu_except_ptr_stack
3371 create_var_decl
3376 gnu_except_ptr_stack);
3378 /* Generate code for each exception handler. The code at
3379 N_Exception_Handler below does the real work. Note that
3380 we ignore the dummy exception handler for the identifier
3381 case, this is used only by the front end */
3389 /* If none of the exception handlers did anything, re-raise
3390 but do not defer abortion. */
3392 expand_expr_stmt
3400 /* End the "if" on setjmp. Note that we have arranged things so
3401 control never returns here. */
3404 /* This is now immediately before the body proper. Set
3405 our jmp_buf as the current buffer. */
3406 expand_expr_stmt
3409 gnu_jmpbuf_decl)));
3410 }
3411 }
3413 /* If there are no exception handlers, we must not have an at end
3414 cleanup identifier, since the cleanup identifier should always
3415 generate a corresponding exception handler. */
3419 /* Generate code and declarations for the prefix of this block,
3420 if any. */
3425 /* Generate code for each statement in the block. */
3432 /* For zero-cost exceptions, exit the block and then compile
3433 the handlers. */
3436 {
3438 gnu_except_ptr_stack
3447 }
3449 /* If we have handlers, close the block we made. */
3451 {
3454 }
3460 {
3461 /* Unless this is "Others" or the special "Non-Ada" exception
3462 for Ada, make an "if" statement to select the proper
3463 exceptions. For "Others", exclude exceptions where
3464 Handled_By_Others is nonzero unless the All_Others flag is set.
3465 For "Non-ada", accept an exception if "Lang" is 'V'. */
3470 {
3471 tree this_choice;
3474 {
3477 else
3478 this_choice
3479 = build_binary_op
3481 convert
3483 build_component_ref
3484 (build_unary_op
3488 integer_zero_node);
3489 }
3493 {
3494 /* ??? Note that we have to use gnat_to_gnu_entity here
3495 since the type of the exception will be wrong in the
3496 VMS case and that's exactly what this test is for. */
3497 gnu_expr
3500 /* If this was a VMS exception, check import_code
3501 against the value of the exception. */
3503 this_choice
3504 = build_binary_op
3506 build_component_ref
3507 (build_unary_op
3511 gnu_expr);
3512 else
3513 this_choice
3514 = build_binary_op
3517 convert
3521 /* If this is the distinguished exception "Non_Ada_Error"
3522 (and we are in VMS mode), also allow a non-Ada
3523 exception (a VMS condition) to match. */
3525 {
3526 tree gnu_comp
3527 = build_component_ref
3528 (build_unary_op
3533 this_choice
3534 = build_binary_op
3536 build_binary_op
3540 this_choice);
3541 }
3542 }
3543 else
3548 }
3553 }
3559 /* At the end of the handler, exit the block. We made this block
3560 in N_Handled_Sequence_Of_Statements. */
3568 /*******************************/
3569 /* Chapter 12: Generic Units: */
3570 /*******************************/
3580 /* These nodes can appear on a declaration list but there is nothing to
3581 to be done with them. */
3585 /***************************************************/
3586 /* Chapter 13: Representation Clauses and */
3587 /* Implementation-Dependent Features: */
3588 /***************************************************/
3592 /* The only one we need deal with is for 'Address. For the others, SEM
3593 puts the information elsewhere. We need only deal with 'Address
3594 if the object has a Freeze_Node (which it never will currently). */
3599 /* Get the value to use as the address and save it as the
3600 equivalent for GNAT_TEMP. When the object is frozen,
3601 gnat_to_gnu_entity will do the right thing. */
3609 /* We do nothing with these. SEM puts the information elsewhere. */
3614 {
3620 /* First process inputs, then outputs, then clobbers. */
3623 {
3628 gnu_input_list
3631 }
3635 {
3640 gnu_orig_out_list
3642 gnu_output_list
3645 }
3649 gnu_clobber_list
3652 gnu_clobber_list);
3659 /* Copy all the intermediate outputs into the specified outputs. */
3664 {
3665 expand_expr_stmt
3670 }
3671 }
3674 /***************************************************/
3675 /* Added Nodes */
3676 /***************************************************/
3690 {
3692 tree gnu_obj_type;
3693 tree gnu_obj_size;
3696 /* If this is an unconstrained array, we know the object must
3697 have been allocated with the template in front of the object.
3698 So pass the template address, but get the total size. Do this
3699 by converting to a thin pointer. */
3701 gnu_ptr
3703 (TYPE_OBJECT_RECORD_TYPE
3705 gnu_ptr);
3713 {
3716 tree gnu_byte_offset
3723 }
3726 expand_expr_stmt
3730 }
3741 gnu_result
3742 = build_call_raise
3744 ? raise_constraint_error_decl
3748 /* If the type is VOID, this is a statement, so we need to
3749 generate the code for the call. Handle a Condition, if there
3750 is one. */
3752 {
3762 }
3763 else
3767 /* Nothing to do, since front end does all validation using the
3768 values that Gigi back-annotates. */
3781 }
3783 /* If the result is a constant that overflows, raise constraint error. */
3786 {
3789 gnu_result
3792 }
3794 /* If our result has side-effects and is of an unconstrained type,
3795 make a SAVE_EXPR so that we can be sure it will only be referenced
3796 once. Note we must do this before any conversions. */
3803 /* Now convert the result to the proper type. If the type is void or if
3804 we have no result, return error_mark_node to show we have no result.
3805 If the type of the result is correct or if we have a label (which doesn't
3806 have any well-defined type), return our result. Also don't do the
3807 conversion if the "desired" type involves a PLACEHOLDER_EXPR in its size
3808 since those are the cases where the front end may have the type wrong due
3809 to "instantiating" the unconstrained record with discriminant values
3810 or if this is a FIELD_DECL. If this is the Name of an assignment
3811 statement or a parameter of a procedure call, return what we have since
3812 the RHS has to be converted to our type there in that case, unless
3813 GNU_RESULT_TYPE has a simpler size. Similarly, if the two types are
3814 record types with the same name, the expression type has integral mode,
3815 and GNU_RESULT_TYPE BLKmode, don't convert. This will be the case when
3816 we are converting from a packable type to its actual type and we need
3817 those conversions to be NOPs in order for assignments into these types to
3818 work properly if the inner object is a bitfield and hence can't have
3819 its address taken. Finally, don't convert integral types that are the
3820 operand of an unchecked conversion since we need to ignore those
3821 conversions (for 'Valid). Otherwise, convert the result to the proper
3822 type. */
3844 && (contains_placeholder_p
3848 {
3849 /* In this case remove padding only if the inner object is of
3850 self-referential size: in that case it must be an object of
3851 unconstrained type with a default discriminant. In other cases,
3852 we want to avoid copying too much data. */
3859 gnu_result);
3860 }
3876 {
3877 /* Remove any padding record, but do nothing more in this case. */
3881 gnu_result);
3882 }
3890 /* We don't need any NOP_EXPR or NON_LVALUE_EXPR on GNU_RESULT. */
3897 }
3898 \f
3899 /* Force references to each of the entities in packages GNAT_NODE with's
3900 so that the debugging information for all of them are identical
3901 in all clients. Operate recursively on anything it with's, but check
3902 that we aren't elaborating something more than once. */
3904 /* The reason for this routine's existence is two-fold.
3905 First, with some debugging formats, notably MDEBUG on SGI
3906 IRIX, the linker will remove duplicate debugging information if two
3907 clients have identical debugguing information. With the normal scheme
3908 of elaboration, this does not usually occur, since entities in with'ed
3909 packages are elaborated on demand, and if clients have different usage
3910 patterns, the normal case, then the order and selection of entities
3911 will differ. In most cases however, it seems that linkers do not know
3912 how to eliminate duplicate debugging information, even if it is
3913 identical, so the use of this routine would increase the total amount
3914 of debugging information in the final executable.
3916 Second, this routine is called in type_annotate mode, to compute DDA
3917 information for types in withed units, for ASIS use */
3919 static void
3921 Node_Id gnat_node;
3922 {
3927 /* Save entities in all context units. A body may have an implicit_with
3928 on its own spec, if the context includes a child unit, so don't save
3929 the spec twice. */
3937 {
3957 }
3961 }
3962 \f
3963 /* Do the processing of N_Freeze_Entity, GNAT_NODE. */
3965 static void
3967 Node_Id gnat_node;
3968 {
3970 tree gnu_old;
3971 tree gnu_new;
3972 tree gnu_init
3977 /* If this is a package, need to generate code for the package. */
3979 {
3980 insert_code_for
3984 }
3986 /* Check for old definition after the above call. This Freeze_Node
3987 might be for one its Itypes. */
3988 gnu_old
3991 /* If this entity has an Address representation clause, GNU_OLD is the
3992 address, so discard it here. */
3996 /* Don't do anything for class-wide types they are always
3997 transformed into their root type. */
4003 /* Don't do anything for subprograms that may have been elaborated before
4004 their freeze nodes. This can happen, for example because of an inner call
4005 in an instance body. */
4012 /* If we have a non-dummy type old tree, we have nothing to do. Unless
4013 this is the public view of a private type whose full view was not
4014 delayed, this node was never delayed as it should have been.
4015 Also allow this to happen for concurrent types since we may have
4016 frozen both the Corresponding_Record_Type and this type. */
4020 {
4027 else
4029 }
4031 /* Reset the saved tree, if any, and elaborate the object or type for real.
4032 If there is a full declaration, elaborate it and copy the type to
4033 GNAT_ENTITY. Likewise if this is the record subtype corresponding to
4034 a class wide type or subtype. */
4036 {
4045 }
4049 {
4052 /* The above call may have defined this entity (the simplest example
4053 of this is when we have a private enumeral type since the bounds
4054 will have the public view. */
4060 }
4061 else
4064 /* If we've made any pointers to the old version of this type, we
4065 have to update them. Also copy the name of the old object to
4066 the new one. */
4069 {
4073 }
4074 }
4075 \f
4076 /* Process the list of inlined subprograms of GNAT_NODE, which is an
4077 N_Compilation_Unit. */
4079 static void
4081 Node_Id gnat_node;
4082 {
4083 Entity_Id gnat_entity;
4084 Node_Id gnat_body;
4086 /* If we can inline, generate RTL for all the inlined subprograms.
4087 Define the entity first so we set DECL_EXTERNAL. */
4092 {
4096 {
4097 /* ??? This really should always be Present. */
4101 gnat_body
4103 }
4106 {
4109 }
4110 }
4111 }
4112 \f
4113 /* Elaborate decls in the lists GNAT_DECLS and GNAT_DECLS2, if present.
4114 We make two passes, one to elaborate anything other than bodies (but
4115 we declare a function if there was no spec). The second pass
4116 elaborates the bodies.
4118 GNAT_END_LIST gives the element in the list past the end. Normally,
4119 this is Empty, but can be First_Real_Statement for a
4120 Handled_Sequence_Of_Statements.
4122 We make a complete pass through both lists if PASS1P is true, then make
4123 the second pass over both lists if PASS2P is true. The lists usually
4124 correspond to the public and private parts of a package. */
4126 static void
4129 Node_Id gnat_end_list;
4131 {
4133 Node_Id gnat_decl;
4143 {
4146 /* For package specs, we recurse inside the declarations,
4147 thus taking the two pass approach inside the boundary. */
4155 /* Similarly for any declarations in the actions of a
4156 freeze node. */
4158 {
4161 }
4163 /* Package bodies with freeze nodes get their elaboration deferred
4164 until the freeze node, but the code must be placed in the right
4165 place, so record the code position now. */
4173 (Corresponding_Spec
4176 record_code_position
4179 /* We defer most subprogram bodies to the second pass.
4180 However, Init_Proc subprograms cannot be defered, but luckily
4181 don't need to be. */
4185 {
4187 {
4193 }
4194 }
4195 /* For bodies and stubs that act as their own specs, the entity
4196 itself must be elaborated in the first pass, because it may
4197 be used in other declarations. */
4199 {
4200 Node_Id gnat_subprog_id =
4207 }
4209 /* Concurrent stubs stand for the corresponding subprogram bodies,
4210 which are deferred like other bodies. */
4213 ;
4215 else
4217 }
4219 /* Here we elaborate everything we deferred above except for package bodies,
4220 which are elaborated at their freeze nodes. Note that we must also
4221 go inside things (package specs and freeze nodes) the first pass did. */
4227 {
4245 }
4246 }
4247 \f
4248 /* Emits an access check. GNU_EXPR is the expression that needs to be
4249 checked against the NULL pointer. */
4251 static tree
4253 tree gnu_expr;
4254 {
4257 /* This only makes sense if GNU_TYPE is a pointer of some sort. */
4261 /* Checked expressions must be evaluated only once. */
4265 gnu_expr,
4267 integer_zero_node)),
4268 gnu_expr);
4269 }
4271 /* Emits a discriminant check. GNU_EXPR is the expression to be checked and
4272 GNAT_NODE a N_Selected_Component node. */
4274 static tree
4276 tree gnu_expr;
4277 Node_Id gnat_node;
4278 {
4279 Entity_Id orig_comp
4282 tree gnu_discr_fct;
4283 Entity_Id gnat_discr;
4285 tree gnu_cond;
4286 Entity_Id gnat_pref_type;
4287 tree gnu_pref_type;
4291 else
4299 /* Checked expressions must be evaluated only once. */
4302 /* Create the list of the actual parameters as GCC expects it.
4303 This list is the list of the discriminant fields of the
4304 record expression to be discriminant checked. For documentation
4305 on what is the GCC format for this list see under the
4306 N_Function_Call case */
4310 {
4315 }
4317 gnu_pref_type
4322 {
4323 Entity_Id gnat_real_discr
4329 gnu_actual_list
4332 build_component_ref
4335 }
4340 gnu_actual_list,
4341 NULL_TREE);
4344 return
4345 build_unary_op
4350 gnu_expr)));
4351 }
4352 \f
4353 /* Emit code for a range check. GNU_EXPR is the expression to be checked,
4354 GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against
4355 which we have to check. */
4357 static tree
4359 tree gnu_expr;
4360 Entity_Id gnat_range_type;
4361 {
4367 /* If GNU_EXPR has an integral type that is narrower than GNU_RANGE_TYPE,
4368 we can't do anything since we might be truncating the bounds. No
4369 check is needed in this case. */
4375 /* Checked expressions must be evaluated only once. */
4378 /* There's no good type to use here, so we might as well use
4379 integer_type_node. Note that the form of the check is
4380 (not (expr >= lo)) or (not (expr >= hi))
4381 the reason for this slightly convoluted form is that NaN's
4382 are not considered to be in range in the float case. */
4383 return emit_check
4385 invert_truthvalue
4389 invert_truthvalue
4393 gnu_high)))),
4394 gnu_expr);
4395 }
4396 \f
4397 /* Emit code for an index check. GNU_ARRAY_OBJECT is the array object
4398 which we are about to index, GNU_EXPR is the index expression to be
4399 checked, GNU_LOW and GNU_HIGH are the lower and upper bounds
4400 against which GNU_EXPR has to be checked. Note that for index
4401 checking we cannot use the emit_range_check function (although very
4402 similar code needs to be generated in both cases) since for index
4403 checking the array type against which we are checking the indeces
4404 may be unconstrained and consequently we need to retrieve the
4405 actual index bounds from the array object itself
4406 (GNU_ARRAY_OBJECT). The place where we need to do that is in
4407 subprograms having unconstrained array formal parameters */
4409 static tree
4411 tree gnu_array_object;
4412 tree gnu_expr;
4413 tree gnu_low;
4414 tree gnu_high;
4415 {
4416 tree gnu_expr_check;
4418 /* Checked expressions must be evaluated only once. */
4421 /* Must do this computation in the base type in case the expression's
4422 type is an unsigned subtypes. */
4425 /* If GNU_LOW or GNU_HIGH are a PLACEHOLDER_EXPR, qualify them by
4426 the object we are handling. */
4435 /* There's no good type to use here, so we might as well use
4436 integer_type_node. */
4437 return emit_check
4440 gnu_expr_check,
4442 gnu_low)),
4444 gnu_expr_check,
4446 gnu_high))),
4447 gnu_expr);
4448 }
4449 \f
4450 /* Given GNU_COND which contains the condition corresponding to an access,
4451 discriminant or range check, of value GNU_EXPR, build a COND_EXPR
4452 that returns GNU_EXPR if GNU_COND is false and raises a
4453 CONSTRAINT_ERROR if GNU_COND is true. */
4455 static tree
4457 tree gnu_cond;
4458 tree gnu_expr;
4459 {
4460 tree gnu_call;
4464 /* Use an outer COMPOUND_EXPR to make sure that GNU_EXPR will
4465 get evaluated in front of the comparison in case it ends
4466 up being a SAVE_EXPR. Put the whole thing inside its own
4467 SAVE_EXPR do the inner SAVE_EXPR doesn't leak out. */
4471 gnu_cond,
4475 gnu_expr))));
4476 }
4477 \f
4478 /* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing
4479 overflow checks if OVERFLOW_P is nonzero and range checks if
4480 RANGE_P is nonzero. GNAT_TYPE is known to be an integral type.
4481 If TRUNCATE_P is nonzero, do a float to integer conversion with
4482 truncation; otherwise round. */
4484 static tree
4486 Entity_Id gnat_type;
4487 tree gnu_expr;
4491 {
4503 /* If we are not doing any checks, the output is an integral type, and
4504 the input is not a floating type, just do the conversion. This
4505 shortcut is required to avoid problems with packed array types
4506 and simplifies code in all cases anyway. */
4511 /* First convert the expression to its base type. This
4512 will never generate code, but makes the tests below much simpler.
4513 But don't do this if converting from an integer type to an unconstrained
4514 array type since then we need to get the bounds from the original
4515 (unpacked) type. */
4519 /* If overflow checks are requested, we need to be sure the result will
4520 fit in the output base type. But don't do this if the input
4521 is integer and the output floating-point. */
4524 {
4525 /* Ensure GNU_EXPR only gets evaluated once. */
4529 /* Convert the lower bounds to signed types, so we're sure we're
4530 comparing them properly. Likewise, convert the upper bounds
4531 to unsigned types. */
4545 /* Check each bound separately and only if the result bound
4546 is tighter than the bound on the input type. Note that all the
4547 types are base types, so the bounds must be constant. Also,
4548 the comparison is done in the base type of the input, which
4549 always has the proper signedness. First check for input
4550 integer (which means output integer), output float (which means
4551 both float), or mixed, in which case we always compare.
4552 Note that we have to do the comparison which would *fail* in the
4553 case of an error since if it's an FP comparison and one of the
4554 values is a NaN or Inf, the comparison will fail. */
4561 gnu_cond
4562 = invert_truthvalue
4565 gnu_out_lb)));
4573 gnu_cond
4575 invert_truthvalue
4577 gnu_input,
4579 gnu_out_ub))));
4583 }
4585 /* Now convert to the result base type. If this is a non-truncating
4586 float-to-integer conversion, round. */
4589 {
4599 gnu_result
4601 }
4607 else
4610 /* Finally, do the range check if requested. Note that if the
4611 result type is a modular type, the range check is actually
4612 an overflow check. */
4620 }
4621 \f
4622 /* Return 1 if GNU_EXPR can be directly addressed. This is the case unless
4623 it is an expression involving computation or if it involves a bitfield
4624 reference. This returns the same as mark_addressable in most cases. */
4626 static int
4628 tree gnu_expr;
4629 {
4631 {
4656 {
4657 /* This is addressable if the code in gnat_expand_expr can do
4658 it by either just taking the operand or by pointer punning. */
4672 }
4676 }
4677 }
4678 \f
4679 /* Do the processing for the declaration of a GNAT_ENTITY, a type. If
4680 a separate Freeze node exists, delay the bulk of the processing. Otherwise
4681 make a GCC type for GNAT_ENTITY and set up the correspondance. */
4683 void
4685 Entity_Id gnat_entity;
4686 {
4687 tree gnu_old
4689 tree gnu_new;
4691 /* If we are to delay elaboration of this type, just do any
4692 elaborations needed for expressions within the declaration and
4693 make a dummy type entry for this node and its Full_View (if
4694 any) in case something points to it. Don't do this if it
4695 has already been done (the only way that can happen is if
4696 the private completion is also delayed). */
4702 {
4706 {
4715 }
4718 }
4720 /* If we saved away a dummy type for this node it means that this
4721 made the type that corresponds to the full type of an incomplete
4722 type. Clear that type for now and then update the type in the
4723 pointers. */
4725 {
4728 {
4729 /* If this was a withed access type, this is not an error
4730 and merely indicates we've already elaborated the type
4731 already. */
4736 }
4739 }
4741 /* Now fully elaborate the type. */
4746 /* If we have an old type and we've made pointers to this type,
4747 update those pointers. */
4752 /* If this is a record type corresponding to a task or protected type
4753 that is a completion of an incomplete type, perform a similar update
4754 on the type. */
4755 /* ??? Including protected types here is a guess. */
4760 {
4761 tree gnu_task_old
4771 }
4772 }
4773 \f
4774 /* GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate.
4775 GNU_TYPE is the GCC type of the corresponding record.
4777 Return a CONSTRUCTOR to build the record. */
4779 static tree
4781 Node_Id gnat_assoc;
4782 tree gnu_type;
4783 {
4786 /* We test for GNU_FIELD being empty in the case where a variant
4787 was the last thing since we don't take things off GNAT_ASSOC in
4788 that case. We check GNAT_ASSOC in case we have a variant, but it
4789 has no fields. */
4793 {
4798 /* The expander is supposed to put a single component selector name
4799 in every record component association */
4803 /* Before assigning a value in an aggregate make sure range checks
4804 are done if required. Then convert to the type of the field. */
4810 /* Add the field and expression to the list. */
4812 }
4816 /* Verify every enty in GNU_LIST was used. */
4822 }
4824 /* Builds a possibly nested constructor for array aggregates. GNAT_EXPR
4825 is the first element of an array aggregate. It may itself be an
4826 aggregate (an array or record aggregate). GNU_ARRAY_TYPE is the gnu type
4827 corresponding to the array aggregate. GNAT_COMPONENT_TYPE is the type
4828 of the array component. It is needed for range checking. */
4830 static tree
4832 Node_Id gnat_expr;
4833 tree gnu_array_type;
4834 Entity_Id gnat_component_type;
4835 {
4836 tree gnu_expr;
4840 {
4841 /* If the expression is itself an array aggregate then first build the
4842 innermost constructor if it is part of our array (multi-dimensional
4843 case). */
4850 gnat_component_type);
4851 else
4852 {
4855 /* before assigning the element to the array make sure it is
4856 in range */
4859 }
4861 gnu_expr_list
4863 gnu_expr_list);
4864 }
4867 }
4868 \f
4869 /* Subroutine of assoc_to_constructor: VALUES is a list of field associations,
4870 some of which are from RECORD_TYPE. Return a CONSTRUCTOR consisting
4871 of the associations that are from RECORD_TYPE. If we see an internal
4872 record, make a recursive call to fill it in as well. */
4874 static tree
4876 tree values;
4877 tree record_type;
4878 {
4883 {
4886 /* _Parent is an internal field, but may have values in the aggregate,
4887 so check for values first. */
4889 {
4892 }
4895 {
4900 }
4901 else
4902 /* If we have a record subtype, the names will match, but not the
4903 actual FIELD_DECLs. */
4906 {
4909 }
4915 }
4918 }
4919 \f
4920 /* EXP is to be treated as an array or record. Handle the cases when it is
4921 an access object and perform the required dereferences. */
4923 static tree
4925 tree exp;
4926 {
4927 /* If the type is a pointer, dereference it. */
4932 /* If we got a padded type, remove it too. */
4938 }
4939 \f
4940 /* Surround EXP with a SAVE_EXPR, but handle unconstrained objects specially
4941 since it doesn't make any sense to put them in a SAVE_EXPR. */
4943 tree
4945 tree exp;
4946 {
4949 /* If this is an unchecked conversion, save the input since we may need to
4950 handle this expression separately if it's the operand of a component
4951 reference. */
4956 /* If this is an aggregate type, we may be doing a dereference of it in
4957 the LHS side of an assignment. In that case, we need to evaluate
4958 it , take its address, make a SAVE_EXPR of that, then do the indirect
4959 reference. Note that for an unconstrained array, the effect will be
4960 to make a SAVE_EXPR of the fat pointer.
4962 ??? This is an efficiency problem in the case of a type that can be
4963 placed into memory, but until we can deal with the LHS issue,
4964 we have to take that hit. This really should test for BLKmode. */
4967 return
4971 exp)));
4973 /* Otherwise, just do the usual thing. */
4975 }
4976 \f
4977 /* This is equivalent to stabilize_reference in GCC's tree.c, but we know
4978 how to handle our new nodes and we take an extra argument that says
4979 whether to force evaluation of everything. */
4981 tree
4983 tree ref;
4985 {
4991 {
4995 /* No action is needed in this case. */
5007 result
5016 force));
5022 force),
5030 force),
5032 force));
5039 force));
5046 force));
5052 force),
5054 force));
5063 /* If arg isn't a kind of lvalue we recognize, make no change.
5064 Caller should recognize the error for an invalid lvalue. */
5070 }
5074 }
5076 /* Similar to stabilize_reference_1 in tree.c, but supports an extra
5077 arg to force a SAVE_EXPR for everything. */
5079 static tree
5081 tree e;
5083 {
5088 /* We cannot ignore const expressions because it might be a reference
5089 to a const array but whose index contains side-effects. But we can
5090 ignore things that are actual constant or that already have been
5091 handled by this function. */
5097 {
5111 /* Constants need no processing. In fact, we should never reach
5112 here. */
5116 /* Division is slow and tends to be compiled with jumps,
5117 especially the division by powers of 2 that is often
5118 found inside of an array reference. So do it just once. */
5124 /* Recursively stabilize each operand. */
5131 /* Recursively stabilize each operand. */
5134 force));
5139 }
5143 }
5144 \f
5145 /* GNAT_UNIT is the Defining_Identifier for some package or subprogram,
5146 either a spec or a body, BODY_P says which. If needed, make a function
5147 to be the elaboration routine for that object and perform the elaborations
5148 in GNU_ELAB_LIST.
5150 Return 1 if we didn't need an elaboration function, zero otherwise. */
5152 static int
5154 Entity_Id gnat_unit;
5156 tree gnu_elab_list;
5157 {
5158 tree gnu_decl;
5159 rtx insn;
5162 /* If we have nothing to do, return. */
5166 /* Set our file and line number to that of the object and set up the
5167 elaboration routine. */
5169 body_p ?
5181 /* Emit the assignments for the elaborations we have to do. If there
5182 is no destination, this is just a call to execute some statement
5183 that was placed within the declarative region. But first save a
5184 pointer so we can see if any insns were generated. */
5190 {
5193 }
5194 else
5195 {
5201 /* If LHS has a padded type, convert it to the unpadded type
5202 so the assignment is done properly. */
5211 }
5213 /* See if any non-NOTE insns were generated. */
5216 {
5219 }
5226 /* If there were no insns, we don't need an elab routine. It would
5227 be nice to not output this one, but there's no good way to do that. */
5229 }
5230 \f
5233 /* Determine the input_filename and the lineno from the source location
5234 (Sloc) of GNAT_NODE node. Set the global variable input_filename and
5235 lineno. If WRITE_NOTE_P is true, emit a line number note. */
5237 void
5239 Node_Id gnat_node;
5241 {
5244 /* If node not from source code, ignore. */
5248 /* Use the identifier table to make a hashed, permanent copy of the filename,
5249 since the name table gets reallocated after Gigi returns but before all
5250 the debugging information is output. The call to
5251 __gnat_to_canonical_file_spec translates filenames from pragmas
5252 Source_Reference that contain host style syntax not understood by gdb. */
5253 input_filename
5254 = IDENTIFIER_POINTER
5255 (get_identifier
5256 (__gnat_to_canonical_file_spec
5257 (Get_Name_String
5260 /* ref_filename is the reference file name as given by sinput (i.e no
5261 directory) */
5262 ref_filename
5263 = IDENTIFIER_POINTER
5264 (get_identifier
5265 (Get_Name_String
5271 }
5272 \f
5273 /* Post an error message. MSG is the error message, properly annotated.
5274 NODE is the node at which to post the error and the node to use for the
5275 "&" substitution. */
5277 void
5280 Node_Id node;
5281 {
5282 String_Template temp;
5283 Fat_Pointer fp;
5289 }
5291 /* Similar, but NODE is the node at which to post the error and ENT
5292 is the node to use for the "&" substitution. */
5294 void
5297 Node_Id node;
5298 Entity_Id ent;
5299 {
5300 String_Template temp;
5301 Fat_Pointer fp;
5307 }
5309 /* Similar, but NODE is the node at which to post the error, ENT is the node
5310 to use for the "&" substitution, and N is the number to use for the ^. */
5312 void
5315 Node_Id node;
5316 Entity_Id ent;
5318 {
5319 String_Template temp;
5320 Fat_Pointer fp;
5328 }
5329 \f
5330 /* Similar to post_error_ne_num, but T is a GCC tree representing the
5331 number to write. If the tree represents a constant that fits within
5332 a host integer, the text inside curly brackets in MSG will be output
5333 (presumably including a '^'). Otherwise that text will not be output
5334 and the text inside square brackets will be output instead. */
5336 void
5339 Node_Id node;
5340 Entity_Id ent;
5341 tree t;
5342 {
5345 Fat_Pointer fp;
5353 #if HOST_BITS_PER_WIDE_INT > HOST_BITS_PER_INT
5355 #endif
5356 )
5357 {
5360 }
5361 else
5365 {
5371 ;
5372 else
5374 }
5381 }
5383 /* Similar to post_error_ne_tree, except that NUM is a second
5384 integer to write in the message. */
5386 void
5389 Node_Id node;
5390 Entity_Id ent;
5391 tree t;
5393 {
5396 }
5398 /* Set the node for a second '&' in the error message. */
5400 void
5402 Entity_Id e;
5403 {
5405 }
5406 \f
5407 /* Signal abort, with "Gigi abort" as the error label, and error_gnat_node
5408 as the relevant node that provides the location info for the error */
5410 void
5413 {
5415 Fat_Pointer fp;
5421 }
5422 \f
5423 /* Initialize the table that maps GNAT codes to GCC codes for simple
5424 binary and unary operations. */
5426 void
5428 {
5454 }