| blob | 678801225032d624bf95b004ed3f102b0fad140b |
1 /****************************************************************************
2 * *
3 * GNAT COMPILER COMPONENTS *
4 * *
5 * T R A N S *
6 * *
7 * C Implementation File *
8 * *
9 * Copyright (C) 1992-2007, Free Software Foundation, Inc. *
10 * *
11 * GNAT is free software; you can redistribute it and/or modify it under *
12 * terms of the GNU General Public License as published by the Free Soft- *
13 * ware Foundation; either version 2, or (at your option) any later ver- *
14 * sion. GNAT is distributed in the hope that it will be useful, but WITH- *
15 * OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *
16 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License *
17 * for more details. You should have received a copy of the GNU General *
18 * Public License distributed with GNAT; see file COPYING. If not, write *
19 * to the Free Software Foundation, 51 Franklin Street, Fifth Floor, *
20 * Boston, MA 02110-1301, USA. *
21 * *
22 * GNAT was originally developed by the GNAT team at New York University. *
23 * Extensive contributions were provided by Ada Core Technologies Inc. *
24 * *
25 ****************************************************************************/
60 /* Let code below know whether we are targetting VMS without need of
61 intrusive preprocessor directives. */
62 #ifndef TARGET_ABI_OPEN_VMS
63 #define TARGET_ABI_OPEN_VMS 0
64 #endif
77 /* Current filename without path. */
80 /* If true, then gigi is being called on an analyzed but unexpanded
81 tree, and the only purpose of the call is to properly annotate
82 types with representation information. */
85 /* A structure used to gather together information about a statement group.
86 We use this to gather related statements, for example the "then" part
87 of a IF. In the case where it represents a lexical scope, we may also
88 have a BLOCK node corresponding to it and/or cleanups. */
95 };
99 /* List of unused struct stmt_group nodes. */
102 /* A structure used to record information on elaboration procedures
103 we've made and need to process.
105 ??? gnat_node should be Node_Id, but gengtype gets confused. */
111 };
115 /* Free list of TREE_LIST nodes used for stacks. */
118 /* List of TREE_LIST nodes representing a stack of exception pointer
119 variables. TREE_VALUE is the VAR_DECL that stores the address of
120 the raised exception. Nonzero means we are in an exception
121 handler. Not used in the zero-cost case. */
124 /* List of TREE_LIST nodes used to store the current elaboration procedure
125 decl. TREE_VALUE is the decl. */
128 /* Variable that stores a list of labels to be used as a goto target instead of
129 a return in some functions. See processing for N_Subprogram_Body. */
132 /* List of TREE_LIST nodes representing a stack of LOOP_STMT nodes.
133 TREE_VALUE of each entry is the label of the corresponding LOOP_STMT. */
136 /* List of TREE_LIST nodes representing labels for switch statements.
137 TREE_VALUE of each entry is the label at the end of the switch. */
140 /* Map GNAT tree codes to GCC tree codes for simple expressions. */
143 /* Current node being treated, in case abort called. */
144 Node_Id error_gnat_node;
175 \f
176 /* This is the main program of the back-end. It sets up all the table
177 structures and then generates code. */
179 void
187 Int gigi_operating_mode)
188 {
189 tree gnu_standard_long_long_float;
190 tree gnu_standard_exception_type;
210 /* If we are just annotating types, give VOID_TYPE zero sizes to avoid
211 errors. */
213 {
216 }
218 /* Save the type we made for integer as the type for Standard.Integer.
219 Then make the rest of the standard types. Note that some of these
220 may be subtypes. */
226 gnu_standard_long_long_float
228 gnu_standard_exception_type
233 /* Process any Pragma Ident for the main unit. */
234 #ifdef ASM_OUTPUT_IDENT
236 ASM_OUTPUT_IDENT
239 #endif
241 /* If we are using the GCC exception mechanism, let GCC know. */
248 /* Now see if we have any elaboration procedures to deal with. */
250 {
252 tree gnu_stmts;
254 /* Unshare SAVE_EXPRs between subprograms. These are not unshared by
255 the gimplifier for obvious reasons, but it turns out that we need to
256 unshare them for the global level because of SAVE_EXPRs made around
257 checks for global objects and around allocators for global objects
258 of variable size, in order to prevent node sharing in the underlying
259 expression. Note that this implicitly assumes that the SAVE_EXPR
260 nodes themselves are not shared between subprograms, which would be
261 an upstream bug for which we would not change the outcome. */
264 /* Set the current function to be the elaboration procedure and gimplify
265 what we have. */
269 /* We should have a BIND_EXPR, but it may or may not have any statements
270 in it. If it doesn't have any, we have nothing to do. */
275 /* If there are no statements, there is no elaboration code. */
278 else
279 {
280 /* Otherwise, compile the function. Note that we'll be gimplifying
281 it twice, but that's fine for the nodes we use. */
284 }
285 }
286 }
287 \f
288 /* Perform initializations for this module. */
290 void
292 {
293 /* Initialize ourselves. */
297 /* Enable GNAT stack checking method if needed */
300 }
301 \f
302 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier,
303 to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to
304 where we should place the result type. */
306 static tree
308 {
309 tree gnu_result_type;
310 tree gnu_result;
313 /* If the Etype of this node does not equal the Etype of the Entity,
314 something is wrong with the entity map, probably in generic
315 instantiation. However, this does not apply to types. Since we sometime
316 have strange Ekind's, just do this test for objects. Also, if the Etype of
317 the Entity is private, the Etype of the N_Identifier is allowed to be the
318 full type and also we consider a packed array type to be the same as the
319 original type. Similarly, a class-wide type is equivalent to a subtype of
320 itself. Finally, if the types are Itypes, one may be a copy of the other,
321 which is also legal. */
344 /* If this is a reference to a deferred constant whose partial view is an
345 unconstrained private type, the proper type is on the full view of the
346 constant, not on the full view of the type, which may be unconstrained.
348 This may be a reference to a type, for example in the prefix of the
349 attribute Position, generated for dispatching code (see Make_DT in
350 exp_disp,adb). In that case we need the type itself, not is parent,
351 in particular if it is a derived type */
356 {
360 }
361 else
362 {
363 /* Expand the type of this identifier first, in case it is an enumeral
364 literal, which only get made when the type is expanded. There is no
365 order-of-elaboration issue here. We want to use the Actual_Subtype if
366 it has already been elaborated, otherwise the Etype. Avoid using
367 Actual_Subtype for packed arrays to simplify things. */
375 else
379 }
383 /* If we are in an exception handler, force this variable into memory to
384 ensure optimization does not remove stores that appear redundant but are
385 actually needed in case an exception occurs.
387 ??? Note that we need not do this if the variable is declared within the
388 handler, only if it is referenced in the handler and declared in an
389 enclosing block, but we have no way of testing that right now.
391 ??? We used to essentially set the TREE_ADDRESSABLE flag on the variable
392 here, but it can now be removed by the Tree aliasing machinery if the
393 address of the variable is never taken. All we can do is to make the
394 variable volatile, which might incur the generation of temporaries just
395 to access the memory in some circumstances. This can be avoided for
396 variables of non-constant size because they are automatically allocated
397 to memory. There might be no way of allocating a proper temporary for
398 them in any case. We only do this for SJLJ though. */
404 /* Some objects (such as parameters passed by reference, globals of
405 variable size, and renamed objects) actually represent the address
406 of the object. In that case, we must do the dereference. Likewise,
407 deal with parameters to foreign convention subprograms. Call fold
408 here since GNU_RESULT may be a CONST_DECL. */
413 {
415 tree renamed_obj;
419 gnu_result
422 gnu_result));
424 /* If it's a renaming pointer and we are at the right binding level,
425 we can reference the renamed object directly, since the renamed
426 expression has been protected against multiple evaluations. */
432 else
437 }
439 /* The GNAT tree has the type of a function as the type of its result. Also
440 use the type of the result if the Etype is a subtype which is nominally
441 unconstrained. But remove any padding from the resulting type. */
444 {
449 }
451 /* We always want to return the underlying INTEGER_CST for an enumeration
452 literal to avoid the need to call fold in lots of places. But don't do
453 this is the parent will be taking the address of this object. */
455 {
469 }
473 }
474 \f
475 /* Subroutine of gnat_to_gnu to process gnat_node, an N_Pragma. Return
476 any statements we generate. */
478 static tree
480 {
481 Node_Id gnat_temp;
484 /* Check for (and ignore) unrecognized pragma and do nothing if we are just
485 annotating types. */
490 {
492 /* Do nothing at top level: all such variables are already viewable. */
499 {
508 }
514 {
527 }
534 }
537 }
538 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Attribute,
539 to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to
540 where we should place the result type. ATTRIBUTE is the attribute ID. */
542 static tree
544 {
546 tree gnu_result_type;
547 tree gnu_expr;
552 /* If the input is a NULL_EXPR, make a new one. */
554 {
558 }
561 {
564 /* These are just conversions until since representation clauses for
565 enumerations are handled in the front end. */
566 {
573 }
578 /* These just add or subject the constant 1. Representation clauses for
579 enumerations are handled in the front-end. */
584 {
586 gnu_expr
587 = emit_check
589 gnu_expr,
590 attribute == Attr_Pred
594 }
596 gnu_result
605 /* Conversions don't change something's address but can cause us to miss
606 the COMPONENT_REF case below, so strip them off. */
610 /* If we are taking 'Address of an unconstrained object, this is the
611 pointer to the underlying array. */
615 /* ... fall through ... */
621 gnu_result
628 /* For 'Code_Address, find an inner ADDR_EXPR and mark it so that we
629 don't try to build a trampoline. */
631 {
640 }
644 {
645 tree gnu_obj_type;
650 /* If this is an unconstrained array, we know the object must have been
651 allocated with the template in front of the object. So compute the
652 template address.*/
654 gnu_ptr
656 (TYPE_OBJECT_RECORD_TYPE
658 gnu_ptr);
663 {
666 tree gnu_byte_offset
673 }
676 }
685 /* Remove NOPS from gnu_expr and conversions from gnu_prefix.
686 We only use GNU_EXPR to see if a COMPONENT_REF was involved. */
689 ;
695 /* Replace an unconstrained array type with the type of the underlying
696 array. We can't do this with a call to maybe_unconstrained_array
697 since we may have a TYPE_DECL. For 'Max_Size_In_Storage_Elements,
698 use the record type that will be used to allocate the object and its
699 template. */
701 {
705 }
707 /* If we're looking for the size of a field, return the field size.
708 Otherwise, if the prefix is an object, or if 'Object_Size or
709 'Max_Size_In_Storage_Elements has been specified, the result is the
710 GCC size of the type. Otherwise, the result is the RM_Size of the
711 type. */
717 {
718 /* If this is a padded type, the GCC size isn't relevant to the
719 programmer. Normally, what we want is the RM_Size, which was set
720 from the specified size, but if it was not set, we want the size
721 of the relevant field. Using the MAX of those two produces the
722 right result in all case. Don't use the size of the field if it's
723 a self-referential type, since that's never what's wanted. */
727 {
731 gnu_result
734 }
736 {
742 {
746 }
749 }
750 else
752 }
753 else
758 /* Deal with a self-referential size by returning the maximum size for a
759 type and by qualifying the size with the object for 'Size of an
760 object. */
762 {
765 else
767 }
769 /* If the type contains a template, subtract its size. */
777 /* Always perform division using unsigned arithmetic as the size cannot
778 be negative, but may be an overflowed positive value. This provides
779 correct results for sizes up to 512 MB.
781 ??? Size should be calculated in storage elements directly. */
811 {
818 else
819 gnu_result
820 = build_binary_op
822 build_binary_op
834 }
836 /* ... fall through ... */
839 {
844 /* Make sure any implicit dereference gets done. */
852 {
854 tree gnu_type_temp;
860 ;
863 }
870 gnu_result
873 gnu_result
875 else
876 /* 'Length or 'Range_Length. */
877 {
878 tree gnu_compute_type
882 gnu_result
883 = build_binary_op
885 build_binary_op
887 build_binary_op
890 TYPE_MAX_VALUE
893 TYPE_MIN_VALUE
897 }
899 /* If this has a PLACEHOLDER_EXPR, qualify it by the object we are
900 handling. Note that these attributes could not have been used on
901 an unconstrained array type. */
903 gnu_prefix);
905 }
912 {
913 HOST_WIDE_INT bitsize;
914 HOST_WIDE_INT bitpos;
915 tree gnu_offset;
916 tree gnu_field_bitpos;
917 tree gnu_field_offset;
918 tree gnu_inner;
926 /* We can have 'Bit on any object, but if it isn't a COMPONENT_REF,
927 the result is 0. Don't allow 'Bit on a bare component, though. */
931 {
934 }
936 else
945 {
953 {
954 gnu_field_bitpos
957 gnu_field_offset
960 }
961 }
963 {
966 }
967 else
968 {
971 }
974 {
989 bitsize_one_node);
995 }
997 /* If this has a PLACEHOLDER_EXPR, qualify it by the object
998 we are handling. */
1001 }
1005 {
1013 }
1041 /* Note this size cannot be self-referential. */
1048 /* This is just a zero cast to the pointer type for
1049 our prefix and dereferenced. */
1051 gnu_result
1054 integer_zero_node));
1059 {
1066 {
1071 ;
1072 }
1080 && (DECL_BY_COMPONENT_PTR_P
1084 }
1088 /* Say we have an unimplemented attribute. Then set the value to be
1089 returned to be a zero and hope that's something we can convert to the
1090 type of this attribute. */
1095 }
1097 /* If this is an attribute where the prefix was unused, force a use of it if
1098 it has a side-effect. But don't do it if the prefix is just an entity
1099 name. However, if an access check is needed, we must do it. See second
1100 example in AARM 11.6(5.e). */
1108 }
1109 \f
1110 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Case_Statement,
1111 to a GCC tree, which is returned. */
1113 static tree
1115 {
1116 tree gnu_result;
1117 tree gnu_expr;
1118 Node_Id gnat_when;
1123 /* The range of values in a case statement is determined by the rules in
1124 RM 5.4(7-9). In almost all cases, this range is represented by the Etype
1125 of the expression. One exception arises in the case of a simple name that
1126 is parenthesized. This still has the Etype of the name, but since it is
1127 not a name, para 7 does not apply, and we need to go to the base type.
1128 This is the only case where parenthesization affects the dynamic
1129 semantics (i.e. the range of possible values at runtime that is covered
1130 by the others alternative.
1132 Another exception is if the subtype of the expression is non-static. In
1133 that case, we also have to use the base type. */
1139 /* We build a SWITCH_EXPR that contains the code with interspersed
1140 CASE_LABEL_EXPRs for each label. */
1147 {
1148 Node_Id gnat_choice;
1151 /* First compile all the different case choices for the current WHEN
1152 alternative. */
1155 {
1159 {
1174 /* This represents either a subtype range or a static value of
1175 some kind; Ekind says which. If a static value, fall through
1176 to the next case. */
1178 {
1184 }
1186 /* ... fall through ... */
1198 }
1200 /* If the case value is a subtype that raises Constraint_Error at
1201 run-time because of a wrong bound, then gnu_low or gnu_high
1202 is not translated into an INTEGER_CST. In such a case, we need
1203 to ensure that the when statement is not added in the tree,
1204 otherwise it will crash the gimplifier. */
1207 {
1212 gnat_choice);
1213 choices_added++;
1214 }
1215 }
1217 /* Push a binding level here in case variables are declared since we want
1218 them to be local to this set of statements instead of the block
1219 containing the Case statement. */
1222 {
1226 }
1227 }
1229 /* Now emit a definition of the label all the cases branched to. */
1237 }
1238 \f
1239 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Loop_Statement,
1240 to a GCC tree, which is returned. */
1242 static tree
1244 {
1245 /* ??? It would be nice to use "build" here, but there's no build5. */
1251 tree gnu_result;
1258 /* Save the end label of this LOOP_STMT in a stack so that the corresponding
1259 N_Exit_Statement can find it. */
1263 /* Set the condition that under which the loop should continue.
1264 For "LOOP .... END LOOP;" the condition is always true. */
1266 ;
1267 /* The case "WHILE condition LOOP ..... END LOOP;" */
1271 else
1272 {
1273 /* We have an iteration scheme. */
1288 /* We know the loop variable will not overflow if GNU_LAST is a constant
1289 and is not equal to GNU_LIMIT. If it might overflow, we have to move
1290 the limit test to the end of the loop. In that case, we have to test
1291 for an empty loop outside the loop. */
1295 {
1296 gnu_cond_expr
1302 }
1304 /* Open a new nesting level that will surround the loop to declare the
1305 loop index variable. */
1309 /* Declare the loop index and set it to its initial value. */
1314 /* The loop variable might be a padded type, so use `convert' to get a
1315 reference to the inner variable if so. */
1318 /* Set either the top or bottom exit condition as appropriate depending
1319 on whether or not we know an overflow cannot occur. */
1324 else
1333 gnu_loop_var,
1335 integer_one_node));
1337 gnat_iter_scheme);
1338 }
1340 /* If the loop was named, have the name point to this loop. In this case,
1341 the association is not a ..._DECL node, but the end label from this
1342 LOOP_STMT. */
1347 /* Make the loop body into its own block, so any allocated storage will be
1348 released every iteration. This is needed for stack allocation. */
1352 /* If we declared a variable, then we are in a statement group for that
1353 declaration. Add the LOOP_STMT to it and make that the "loop". */
1355 {
1359 }
1361 /* If we have an outer COND_EXPR, that's our result and this loop is its
1362 "true" statement. Otherwise, the result is the LOOP_STMT. */
1364 {
1368 }
1369 else
1375 }
1376 \f
1377 /* Emit statements to establish __gnat_handle_vms_condition as a VMS condition
1378 handler for the current function. */
1380 /* This is implemented by issuing a call to the appropriate VMS specific
1381 builtin. To avoid having VMS specific sections in the global gigi decls
1382 array, we maintain the decls of interest here. We can't declare them
1383 inside the function because we must mark them never to be GC'd, which we
1384 can only do at the global level. */
1389 static void
1391 {
1392 tree establish_stmt;
1394 /* Elaborate the required decls on the first call. Check on the decl for
1395 the gnat condition handler to decide, as this is one we create so we are
1396 sure that it will be non null on subsequent calls. The builtin decl is
1397 looked up so remains null on targets where it is not implemented yet. */
1399 {
1400 vms_builtin_establish_handler_decl
1401 = builtin_decl_for
1404 gnat_vms_condition_handler_decl
1406 NULL_TREE,
1408 ptr_void_type_node,
1409 ptr_void_type_node,
1410 NULL_TREE),
1412 }
1414 /* Do nothing if the establish builtin is not available, which might happen
1415 on targets where the facility is not implemented. */
1419 establish_stmt
1421 build_unary_op
1423 gnat_vms_condition_handler_decl));
1426 }
1427 \f
1428 /* Subroutine of gnat_to_gnu to process gnat_node, an N_Subprogram_Body. We
1429 don't return anything. */
1431 static void
1433 {
1434 /* Save debug output mode in case it is reset. */
1437 /* Defining identifier of a parameter to the subprogram. */
1438 Entity_Id gnat_param;
1439 /* The defining identifier for the subprogram body. Note that if a
1440 specification has appeared before for this body, then the identifier
1441 occurring in that specification will also be a defining identifier and all
1442 the calls to this subprogram will point to that specification. */
1443 Entity_Id gnat_subprog_id
1446 /* The FUNCTION_DECL node corresponding to the subprogram spec. */
1447 tree gnu_subprog_decl;
1448 /* The FUNCTION_TYPE node corresponding to the subprogram spec. */
1449 tree gnu_subprog_type;
1450 tree gnu_cico_list;
1451 tree gnu_result;
1453 /* If this is a generic object or if it has been eliminated,
1454 ignore it. */
1460 /* If debug information is suppressed for the subprogram, turn debug
1461 mode off for the duration of processing. */
1463 {
1466 }
1468 /* If this subprogram acts as its own spec, define it. Otherwise, just get
1469 the already-elaborated tree node. However, if this subprogram had its
1470 elaboration deferred, we will already have made a tree node for it. So
1471 treat it as not being defined in that case. Such a subprogram cannot
1472 have an address clause or a freeze node, so this test is safe, though it
1473 does disable some otherwise-useful error checking. */
1474 gnu_subprog_decl
1481 /* Set the line number in the decl to correspond to that of the body so that
1482 the line number notes are written
1483 correctly. */
1489 /* If there are OUT parameters, we need to ensure that the return statement
1490 properly copies them out. We do this by making a new block and converting
1491 any inner return into a goto to a label at the end of the block. */
1495 /* Get a tree corresponding to the code for the subprogram. */
1499 /* See if there are any parameters for which we don't yet have GCC entities.
1500 These must be for OUT parameters for which we will be making VAR_DECL
1501 nodes here. Fill them in to TYPE_CI_CO_LIST, which must contain the empty
1502 entry as well. We can match up the entries because TYPE_CI_CO_LIST is in
1503 the order of the parameters. */
1508 {
1509 /* Skip any entries that have been already filled in; they must
1510 correspond to IN OUT parameters. */
1513 ;
1515 /* Do any needed references for padded types. */
1519 }
1522 /* On VMS, establish our condition handler to possibly turn a condition into
1523 the corresponding exception if the subprogram has a foreign convention or
1524 is exported.
1526 To ensure proper execution of local finalizations on condition instances,
1527 we must turn a condition into the corresponding exception even if there
1528 is no applicable Ada handler, and need at least one condition handler per
1529 possible call chain involving GNAT code. OTOH, establishing the handler
1530 has a cost so we want to minimize the number of subprograms into which this
1531 happens. The foreign or exported condition is expected to satisfy all
1532 the constraints. */
1539 /* Generate the code of the subprogram itself. A return statement will be
1540 present and any OUT parameters will be handled there. */
1545 /* If we made a special return label, we need to make a block that contains
1546 the definition of that label and the copying to the return value. That
1547 block first contains the function, then the label and copy statement. */
1549 {
1550 tree gnu_retval;
1561 else
1563 gnu_cico_list);
1568 add_stmt_with_node
1570 gnat_node);
1573 }
1577 /* Initialize the information node for the function and set the
1578 end location. */
1580 Sloc_to_locus
1588 /* Disconnect the trees for parameters that we made variables for from the
1589 GNAT entities since these are unusable after we end the function. */
1599 }
1600 \f
1601 /* Subroutine of gnat_to_gnu to translate gnat_node, either an N_Function_Call
1602 or an N_Procedure_Call_Statement, to a GCC tree, which is returned.
1603 GNU_RESULT_TYPE_P is a pointer to where we should place the result type.
1604 If GNU_TARGET is non-null, this must be a function call and the result
1605 of the call is to be placed into that object. */
1607 static tree
1609 {
1610 tree gnu_result;
1611 /* The GCC node corresponding to the GNAT subprogram name. This can either
1612 be a FUNCTION_DECL node if we are dealing with a standard subprogram call,
1613 or an indirect reference expression (an INDIRECT_REF node) pointing to a
1614 subprogram. */
1616 /* The FUNCTION_TYPE node giving the GCC type of the subprogram. */
1619 gnu_subprog_node);
1620 Entity_Id gnat_formal;
1621 Node_Id gnat_actual;
1626 tree gnu_subprog_call;
1629 {
1636 }
1640 /* If we are calling a stubbed function, make this into a raise of
1641 Program_Error. Elaborate all our args first. */
1644 {
1650 {
1651 tree call_expr
1655 {
1658 }
1659 else
1661 }
1662 }
1664 /* If we are calling by supplying a pointer to a target, set up that
1665 pointer as the first argument. Use GNU_TARGET if one was passed;
1666 otherwise, make a target by building a variable of the maximum size
1667 of the type. */
1669 {
1670 tree gnu_real_ret_type
1674 {
1675 tree gnu_obj_type
1681 /* ??? We may be about to create a static temporary if we happen to
1682 be at the global binding level. That's a regression from what
1683 the 3.x back-end would generate in the same situation, but we
1684 don't have a mechanism in Gigi for creating automatic variables
1685 in the elaboration routines. */
1686 gnu_target
1689 gnat_node);
1690 }
1692 gnu_actual_list
1696 gnu_target,
1698 NULL_TREE);
1700 }
1702 /* The only way we can be making a call via an access type is if Name is an
1703 explicit dereference. In that case, get the list of formal args from the
1704 type the access type is pointing to. Otherwise, get the formals from
1705 entity being called. */
1709 /* Assume here that this must be 'Elab_Body or 'Elab_Spec. */
1711 else
1714 /* Create the list of the actual parameters as GCC expects it, namely a chain
1715 of TREE_LIST nodes in which the TREE_VALUE field of each node is a
1716 parameter-expression and the TREE_PURPOSE field is null. Skip OUT
1717 parameters not passed by reference and don't need to be copied in. */
1722 {
1723 tree gnu_formal
1727 /* We treat a conversion between aggregate types as if it is an
1728 unchecked conversion. */
1729 bool unchecked_convert_p
1733 Node_Id gnat_name = (unchecked_convert_p
1737 tree gnu_actual;
1739 /* If it's possible we may need to use this expression twice, make sure
1740 than any side-effects are handled via SAVE_EXPRs. Likewise if we need
1741 to force side-effects before the call.
1743 ??? This is more conservative than we need since we don't need to do
1744 this for pass-by-ref with no conversion. If we are passing a
1745 non-addressable Out or In Out parameter by reference, pass the address
1746 of a copy and set up to copy back out after the call. */
1748 {
1752 && gnu_formal
1757 {
1759 tree gnu_temp;
1761 /* If the type is by_reference, a copy is not allowed. */
1763 post_error
1766 /* For users of Starlet we issue a warning because the
1767 interface apparently assumes that by-ref parameters
1768 outlive the procedure invocation. The code still
1769 will not work as intended, but we cannot do much
1770 better since other low-level parts of the back-end
1771 would allocate temporaries at will because of the
1772 misalignment if we did not do so here. */
1775 {
1776 post_error
1778 gnat_actual);
1779 post_error_ne
1782 post_error_ne
1785 }
1787 /* Remove any unpadding on the actual and make a copy. But if
1788 the actual is a justified modular type, first convert
1789 to it. */
1793 && (TYPE_IS_PADDING_P
1800 /* Make a SAVE_EXPR to both properly account for potential side
1801 effects and handle the creation of a temporary copy. Special
1802 code in gnat_gimplify_expr ensures that the same temporary is
1803 used as the actual and copied back after the call. */
1806 /* Set up to move the copy back to the original. */
1812 /* Account for next statement just below. */
1814 }
1815 }
1817 /* If this was a procedure call, we may not have removed any padding.
1818 So do it here for the part we will use as an input, if any. */
1824 gnu_actual);
1826 /* Unless this is an In parameter, we must remove any LJM building
1827 from GNU_NAME. */
1833 gnu_name);
1836 && !unchecked_convert_p
1840 /* Do any needed conversions. We need only check for unchecked
1841 conversion since normal conversions will be handled by just
1842 converting to the formal type. */
1844 {
1845 gnu_actual
1847 gnu_actual,
1852 /* One we've done the unchecked conversion, we still must ensure that
1853 the object is in range of the formal's type. */
1858 }
1860 /* We may have suppressed a conversion to the Etype of the actual since
1861 the parent is a procedure call. So add the conversion here. */
1863 gnu_actual);
1868 /* If we have not saved a GCC object for the formal, it means it is an
1869 OUT parameter not passed by reference and that does not need to be
1870 copied in. Otherwise, look at the PARM_DECL to see if it is passed by
1871 reference. */
1874 {
1876 {
1879 /* If we have a padded type, be sure we've removed padding. */
1884 gnu_actual);
1886 /* If we have the constructed subtype of an aliased object
1887 with an unconstrained nominal subtype, the type of the
1888 actual includes the template, although it is formally
1889 constrained. So we need to convert it back to the real
1890 constructed subtype to retrieve the constrained part
1891 and takes its address. */
1898 gnu_actual);
1899 }
1901 /* Otherwise, if we have a non-addressable COMPONENT_REF of a
1902 variable-size type see if it's doing a unpadding operation. If
1903 so, remove that operation since we have no way of allocating the
1904 required temporary. */
1914 /* For In parameters, gnu_actual might still not be addressable at
1915 this point and we need the creation of a temporary copy since
1916 this is to be passed by ref. Resorting to save_expr to force a
1917 SAVE_EXPR temporary creation here is not guaranteed to work
1918 because the actual might be invariant or readonly without side
1919 effects, so we let the gimplifier process this case. */
1921 /* The symmetry of the paths to the type of an entity is broken here
1922 since arguments don't know that they will be passed by ref. */
1925 }
1928 {
1935 {
1938 }
1940 /* Take the address of the object and convert to the proper pointer
1941 type. We'd like to actually compute the address of the beginning
1942 of the array using an ADDR_EXPR of an ARRAY_REF, but there's a
1943 possibility that the ARRAY_REF might return a constant and we'd be
1944 getting the wrong address. Neither approach is exactly correct,
1945 but this is the most likely to work in all cases. */
1948 gnu_actual));
1949 }
1952 {
1953 /* If arg is 'Null_Parameter, pass zero descriptor. */
1958 integer_zero_node);
1959 else
1962 gnat_formal));
1963 }
1964 else
1965 {
1974 /* If this is 'Null_Parameter, pass a zero even though we are
1975 dereferencing it. */
1980 BITS_PER_WORD))
1981 gnu_actual
1986 integer_zero_node),
1988 else
1990 }
1993 }
1996 gnu_subprog_addr,
1999 /* If we return by passing a target, we emit the call and return the target
2000 as our result. */
2002 {
2004 *gnu_result_type_p
2007 }
2009 /* If it is a function call, the result is the call expression unless
2010 a target is specified, in which case we copy the result into the target
2011 and return the assignment statement. */
2013 {
2016 /* If the function returns an unconstrained array or by reference,
2017 we have to de-dereference the pointer. */
2025 else
2029 }
2031 /* If this is the case where the GNAT tree contains a procedure call
2032 but the Ada procedure has copy in copy out parameters, the special
2033 parameter passing mechanism must be used. */
2035 {
2036 /* List of FIELD_DECLs associated with the PARM_DECLs of the copy
2037 in copy out parameters. */
2042 {
2043 tree gnu_name;
2048 /* If any of the names had side-effects, ensure they are all
2049 evaluated before the call. */
2055 }
2059 else
2066 /* If we are dealing with a copy in copy out parameter, we must
2067 retrieve its value from the record returned in the call. */
2073 || (DECL_BY_DESCRIPTOR_P
2076 {
2077 /* Get the value to assign to this OUT or IN OUT parameter. It is
2078 either the result of the function if there is only a single such
2079 parameter or the appropriate field from the record returned. */
2080 tree gnu_result
2086 /* If the actual is a conversion, get the inner expression, which
2087 will be the real destination, and convert the result to the
2088 type of the actual parameter. */
2089 tree gnu_actual
2092 /* If the result is a padded type, remove the padding. */
2097 gnu_result);
2099 /* If the actual is a type conversion, the real target object is
2100 denoted by the inner Expression and we need to convert the
2101 result to the associated type.
2103 We also need to convert our gnu assignment target to this type
2104 if the corresponding gnu_name was constructed from the GNAT
2105 conversion node and not from the inner Expression. */
2107 {
2108 gnu_result
2109 = convert_with_check
2117 gnu_actual
2119 }
2121 /* Unchecked conversions as actuals for out parameters are not
2122 allowed in user code because they are not variables, but do
2123 occur in front-end expansions. The associated gnu_name is
2124 always obtained from the inner expression in such cases. */
2127 gnu_result,
2129 else
2130 {
2138 }
2146 }
2147 }
2148 else
2149 {
2152 }
2156 }
2157 \f
2158 /* Subroutine of gnat_to_gnu to translate gnat_node, an
2159 N_Handled_Sequence_Of_Statements, to a GCC tree, which is returned. */
2161 static tree
2163 {
2166 /* If just annotating, ignore all EH and cleanups. */
2170 bool setjmp_longjmp
2176 tree gnu_result;
2177 tree gnu_expr;
2178 Node_Id gnat_temp;
2180 /* The GCC exception handling mechanism can handle both ZCX and SJLJ schemes
2181 and we have our own SJLJ mechanism. To call the GCC mechanism, we call
2182 add_cleanup, and when we leave the binding, end_stmt_group will create
2183 the TRY_FINALLY_EXPR.
2185 ??? The region level calls down there have been specifically put in place
2186 for a ZCX context and currently the order in which things are emitted
2187 (region/handlers) is different from the SJLJ case. Instead of putting
2188 other calls with different conditions at other places for the SJLJ case,
2189 it seems cleaner to reorder things for the SJLJ case and generalize the
2190 condition to make it not ZCX specific.
2192 If there are any exceptions or cleanup processing involved, we need an
2193 outer statement group (for Setjmp_Longjmp) and binding level. */
2195 {
2198 }
2200 /* If using setjmp_longjmp, make the variables for the setjmp buffer and save
2201 area for address of previous buffer. Do this first since we need to have
2202 the setjmp buf known for any decls in this block. */
2204 {
2209 gnat_node);
2210 /* The __builtin_setjmp receivers will immediately reinstall it. Now
2211 because of the unstructured form of EH used by setjmp_longjmp, there
2212 might be forward edges going to __builtin_setjmp receivers on which
2213 it is uninitialized, although they will never be actually taken. */
2222 /* When we exit this block, restore the saved value. */
2224 }
2226 /* If we are to call a function when exiting this block, add a cleanup
2227 to the binding level we made above. Note that add_cleanup is FIFO
2228 so we must register this cleanup after the EH cleanup just above. */
2232 /* Now build the tree for the declarations and statements inside this block.
2233 If this is SJLJ, set our jmp_buf as the current buffer. */
2239 gnu_jmpbuf_decl)));
2245 /* Generate code for each statement in the block. */
2253 /* Now generate code for the two exception models, if either is relevant for
2254 this block. */
2256 {
2258 tree gnu_handler;
2260 /* Make a binding level for the exception handling declarations and code
2261 and set up gnu_except_ptr_stack for the handlers to use. */
2267 NULL_TREE,
2272 /* Generate code for each handler. The N_Exception_Handler case does the
2273 real work and returns a COND_EXPR for each handler, which we chain
2274 together here. */
2277 {
2280 /* If this is the first one, set it as the outer one. Otherwise,
2281 point the "else" part of the previous handler to us. Then point
2282 to our "else" part. */
2285 else
2289 }
2291 /* If none of the exception handlers did anything, re-raise but do not
2292 defer abortion. */
2299 else
2302 /* End the binding level dedicated to the exception handlers and get the
2303 whole statement group. */
2308 /* If the setjmp returns 1, we restore our incoming longjmp value and
2309 then check the handlers. */
2312 gnu_jmpsave_decl),
2313 gnat_node);
2317 /* This block is now "if (setjmp) ... <handlers> else <block>". */
2319 (build_call_1_expr
2322 gnu_jmpbuf_decl))),
2324 }
2326 {
2327 tree gnu_handlers;
2329 /* First make a block containing the handlers. */
2337 /* Now make the TRY_CATCH_EXPR for the block. */
2340 }
2341 else
2344 /* Now close our outer block, if we had to make one. */
2346 {
2350 }
2353 }
2354 \f
2355 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Exception_Handler,
2356 to a GCC tree, which is returned. This is the variant for Setjmp_Longjmp
2357 exception handling. */
2359 static tree
2361 {
2362 /* Unless this is "Others" or the special "Non-Ada" exception for Ada, make
2363 an "if" statement to select the proper exceptions. For "Others", exclude
2364 exceptions where Handled_By_Others is nonzero unless the All_Others flag
2365 is set. For "Non-ada", accept an exception if "Lang" is 'V'. */
2368 Node_Id gnat_temp;
2372 {
2373 tree this_choice;
2376 {
2379 else
2380 this_choice
2381 = build_binary_op
2383 convert
2385 build_component_ref
2386 (build_unary_op
2391 integer_zero_node);
2392 }
2396 {
2398 tree gnu_expr;
2400 /* Exception may be a renaming. Recover original exception which is
2401 the one elaborated and registered. */
2407 this_choice
2408 = build_binary_op
2413 /* If this is the distinguished exception "Non_Ada_Error" (and we are
2414 in VMS mode), also allow a non-Ada exception (a VMS condition) t
2415 match. */
2417 {
2418 tree gnu_comp
2419 = build_component_ref
2424 this_choice
2425 = build_binary_op
2429 this_choice);
2430 }
2431 }
2432 else
2437 }
2440 }
2441 \f
2442 /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Exception_Handler,
2443 to a GCC tree, which is returned. This is the variant for ZCX. */
2445 static tree
2447 {
2449 tree gnu_expr;
2450 tree gnu_etype;
2451 tree gnu_current_exc_ptr;
2452 tree gnu_incoming_exc_ptr;
2453 Node_Id gnat_temp;
2455 /* We build a TREE_LIST of nodes representing what exception types this
2456 handler can catch, with special cases for others and all others cases.
2458 Each exception type is actually identified by a pointer to the exception
2459 id, or to a dummy object for "others" and "all others".
2461 Care should be taken to ensure that the control flow impact of "others"
2462 and "all others" is known to GCC. lang_eh_type_covers is doing the trick
2463 currently. */
2466 {
2468 {
2469 tree gnu_expr
2472 gnu_etype
2474 }
2477 {
2480 /* Exception may be a renaming. Recover original exception which is
2481 the one elaborated and registered. */
2488 /* The Non_Ada_Error case for VMS exceptions is handled
2489 by the personality routine. */
2490 }
2491 else
2494 /* The GCC interface expects NULL to be passed for catch all handlers, so
2495 it would be quite tempting to set gnu_etypes_list to NULL if gnu_etype
2496 is integer_zero_node. It would not work, however, because GCC's
2497 notion of "catch all" is stronger than our notion of "others". Until
2498 we correctly use the cleanup interface as well, doing that would
2499 prevent the "all others" handlers from being seen, because nothing
2500 can be caught beyond a catch all from GCC's point of view. */
2502 }
2507 /* Expand a call to the begin_handler hook at the beginning of the handler,
2508 and arrange for a call to the end_handler hook to occur on every possible
2509 exit path.
2511 The hooks expect a pointer to the low level occurrence. This is required
2512 for our stack management scheme because a raise inside the handler pushes
2513 a new occurrence on top of the stack, which means that this top does not
2514 necessarily match the occurrence this handler was dealing with.
2516 The EXC_PTR_EXPR object references the exception occurrence being
2517 propagated. Upon handler entry, this is the exception for which the
2518 handler is triggered. This might not be the case upon handler exit,
2519 however, as we might have a new occurrence propagated by the handler's
2520 body, and the end_handler hook called as a cleanup in this context.
2522 We use a local variable to retrieve the incoming value at handler entry
2523 time, and reuse it to feed the end_handler hook's argument at exit. */
2528 gnat_node);
2531 gnu_incoming_exc_ptr),
2532 gnat_node);
2539 }
2540 \f
2541 /* Subroutine of gnat_to_gnu to generate code for an N_Compilation unit. */
2543 static void
2545 {
2546 /* Make the decl for the elaboration procedure. */
2551 tree gnu_elab_proc_decl
2552 = create_subprog_decl
2556 gnat_unit_entity);
2566 /* For a body, first process the spec if there is one. */
2575 {
2582 }
2588 /* Process any pragmas and actions following the unit. */
2592 /* Save away what we've made so far and record this potential elaboration
2593 procedure. */
2603 /* Generate elaboration code for this unit, if necessary, and say whether
2604 we did or not. */
2607 /* Invalidate the global renaming pointers. This is necessary because
2608 stabilization of the renamed entities may create SAVE_EXPRs which
2609 have been tied to a specific elaboration routine just above. */
2611 }
2612 \f
2613 /* This function is the driver of the GNAT to GCC tree transformation
2614 process. It is the entry point of the tree transformer. GNAT_NODE is the
2615 root of some GNAT tree. Return the root of the corresponding GCC tree.
2616 If this is an expression, return the GCC equivalent of the expression. If
2617 it is a statement, return the statement. In the case when called for a
2618 statement, it may also add statements to the current statement group, in
2619 which case anything it returns is to be interpreted as occurring after
2620 anything `it already added. */
2622 tree
2624 {
2628 tree gnu_expr;
2630 Node_Id gnat_temp;
2632 /* Save node number for error message and set location information. */
2640 /* If this node is a non-static subexpression and we are only
2641 annotating types, make this into a NULL_EXPR. */
2649 /* If this is a Statement and we are at top level, it must be part of the
2650 elaboration procedure, so mark us as being in that procedure and push our
2651 context.
2653 If we are in the elaboration procedure, check if we are violating a a
2654 No_Elaboration_Code restriction by having a statement there. */
2665 {
2667 {
2672 }
2674 /* Don't check for a possible No_Elaboration_Code restriction violation
2675 on N_Handled_Sequence_Of_Statements, as we want to signal an error on
2676 every nested real statement instead. This also avoids triggering
2677 spurious errors on dummy (empty) sequences created by the front-end
2678 for package bodies in some cases. */
2683 }
2686 {
2687 /********************************/
2688 /* Chapter 2: Lexical Elements: */
2689 /********************************/
2699 {
2700 tree gnu_type;
2702 /* Get the type of the result, looking inside any padding and
2703 justified modular types. Then get the value in that type. */
2712 /* If the result overflows (meaning it doesn't fit in its base type),
2713 abort. We would like to check that the value is within the range
2714 of the subtype, but that causes problems with subtypes whose usage
2715 will raise Constraint_Error and with biased representation, so
2716 we don't. */
2718 }
2722 /* If a Entity is present, it means that this was one of the
2723 literals in a user-defined character type. In that case,
2724 just return the value in the CONST_DECL. Otherwise, use the
2725 character code. In that case, the base type should be an
2726 INTEGER_TYPE, but we won't bother checking for that. */
2730 else
2731 gnu_result
2732 = build_int_cst_type
2737 /* If this is of a fixed-point type, the value we want is the
2738 value of the corresponding integer. */
2740 {
2743 gnu_result_type);
2745 }
2747 /* We should never see a Vax_Float type literal, since the front end
2748 is supposed to transform these using appropriate conversions */
2752 else
2753 {
2758 /* If the real value is zero, so is the result. Otherwise,
2759 convert it to a machine number if it isn't already. That
2760 forces BASE to 0 or 2 and simplifies the rest of our logic. */
2763 else
2764 {
2766 ur_realval
2770 gnu_result
2773 /* If we have a base of zero, divide by the denominator.
2774 Otherwise, the base must be 2 and we scale the value, which
2775 we know can fit in the mantissa of the type (hence the use
2776 of that type above). */
2778 gnu_result
2781 gnu_result,
2783 gnu_result_type));
2784 else
2785 {
2786 REAL_VALUE_TYPE tmp;
2792 }
2793 }
2795 /* Now see if we need to negate the result. Do it this way to
2796 properly handle -0. */
2798 gnu_result
2800 gnu_result);
2801 }
2808 {
2814 /* Build the string with the characters in the literal. Note
2815 that Ada strings are 1-origin. */
2819 /* Put a null at the end of the string in case it's in a context
2820 where GCC will want to treat it as a C string. */
2825 /* Strings in GCC don't normally have types, but we want
2826 this to not be converted to the array type. */
2828 }
2829 else
2830 {
2831 /* Build a list consisting of each character, then make
2832 the aggregate. */
2840 {
2841 gnu_list
2846 gnu_list);
2850 }
2852 gnu_result
2854 }
2861 /**************************************/
2862 /* Chapter 3: Declarations and Types: */
2863 /**************************************/
2880 /* If we are just annotating types and this object has an unconstrained
2881 or task type, don't elaborate it. */
2892 && (!type_annotate_only
2894 {
2899 /* If this object has its elaboration delayed, we must force
2900 evaluation of GNU_EXPR right now and save it for when the object
2901 is frozen. */
2903 {
2906 gnu_expr
2911 else
2915 }
2916 }
2917 else
2930 /* Don't do anything if this renaming is handled by the front end or if
2931 we are just annotating types and this object has a composite or task
2932 type, don't elaborate it. We return the result in case it has any
2933 SAVE_EXPRs in it that need to be evaluated here. */
2935 && ! (type_annotate_only
2939 gnu_result
2942 else
2955 /* These are fully handled in the front end. */
2959 /*************************************/
2960 /* Chapter 4: Names and Expressions: */
2961 /*************************************/
2970 {
2972 tree gnu_type;
2980 /* If we got a padded type, remove it too. */
2983 gnu_array_object
2985 gnu_array_object);
2989 /* First compute the number of dimensions of the array, then
2990 fill the expression array, the order depending on whether
2991 this is a Convention_Fortran array or not. */
2996 ;
3005 else
3013 {
3019 gnu_expr
3020 = emit_index_check
3027 }
3028 }
3034 {
3035 tree gnu_type;
3041 /* Do any implicit dereferences of the prefix and do any needed
3042 range check. */
3047 {
3048 /* Get the bounds of the slice. */
3049 tree gnu_index_type
3055 /* Check to see that the minimum slice value is in range */
3056 gnu_expr_l
3057 = emit_index_check
3062 /* Check to see that the maximum slice value is in range */
3063 gnu_expr_h
3064 = emit_index_check
3069 /* Derive a good type to convert everything too */
3072 /* Build a compound expression that does the range checks */
3073 gnu_expr
3078 /* Build a conditional expression that returns the range checks
3079 expression if the slice range is not null (max >= min) or
3080 returns the min if the slice range is null */
3081 gnu_expr
3085 gnu_max_expr),
3087 gnu_min_expr)),
3089 }
3090 else
3095 }
3099 {
3103 tree gnu_field;
3107 {
3112 }
3116 /* For discriminant references in tagged types always substitute the
3117 corresponding discriminant as the actual selected component. */
3123 /* For discriminant references of untagged types always substitute the
3124 corresponding stored discriminant. */
3129 /* Handle extracting the real or imaginary part of a complex.
3130 The real part is the first field and the imaginary the last. */
3136 else
3137 {
3140 /* If there are discriminants, the prefix might be
3141 evaluated more than once, which is a problem if it has
3142 side-effects. */
3149 gnu_result
3153 }
3157 }
3161 {
3162 /* The attribute designator (like an enumeration value). */
3165 /* The Elab_Spec and Elab_Body attributes are special in that
3166 Prefix is a unit, not an object with a GCC equivalent. Similarly
3167 for Elaborated, since that variable isn't otherwise known. */
3171 attribute == Attr_Elab_Body
3174 gnat_node));
3177 }
3181 /* Like 'Access as far as we are concerned. */
3189 {
3190 tree gnu_aggr_type;
3192 /* ??? It is wrong to evaluate the type now, but there doesn't
3193 seem to be any other practical way of doing it. */
3197 gnu_aggr_type = gnu_result_type
3202 gnu_aggr_type
3210 gnu_result
3213 gnu_aggr_type);
3216 gnu_aggr_type,
3219 gnu_result
3220 = build_binary_op
3225 (Next
3227 else
3231 }
3241 /* Get the operand expression. */
3245 gnu_result
3257 /* If the result is a pointer type, see if we are improperly
3258 converting to a stricter alignment. */
3262 {
3268 post_error_ne_tree_2
3272 }
3280 {
3283 tree gnu_low;
3284 tree gnu_high;
3286 /* GNAT_RANGE is either an N_Range node or an identifier
3287 denoting a subtype. */
3289 {
3292 }
3295 {
3300 }
3301 else
3306 /* If LOW and HIGH are identical, perform an equality test.
3307 Otherwise, ensure that GNU_OBJECT is only evaluated once
3308 and perform a full range test. */
3312 else
3313 {
3315 gnu_result
3321 }
3325 }
3333 ? RDIV_EXPR
3340 /* These can either be operations on booleans or on modular types.
3341 Fall through for boolean types since that's the way GNU_CODES is
3342 set up. */
3344 Modular_Integer_Kind))
3345 {
3346 enum tree_code code
3357 }
3359 /* ... fall through ... */
3371 {
3374 tree gnu_type;
3380 /* If this is a comparison operator, convert any references to
3381 an unconstrained array value into a reference to the
3382 actual array. */
3384 {
3387 }
3389 /* If the result type is a private type, its full view may be a
3390 numeric subtype. The representation we need is that of its base
3391 type, given that it is the result of an arithmetic operation. */
3393 gnu_type = gnu_result_type
3396 /* If this is a shift whose count is not guaranteed to be correct,
3397 we need to adjust the shift count. */
3400 {
3402 tree gnu_max_shift
3410 gnu_rhs
3411 = build_binary_op
3414 gnu_count_type,
3415 gnu_max_shift,
3417 integer_one_node)),
3418 gnu_rhs);
3419 }
3421 /* For right shifts, the type says what kind of shift to do,
3422 so we may need to choose a different type. In this case,
3423 we have to ignore integer overflow lest it propagates all
3424 the way down and causes a CE to be explicitly raised. */
3427 {
3430 }
3433 {
3436 }
3439 {
3445 }
3449 /* If this is a logical shift with the shift count not verified,
3450 we must return zero if it is too large. We cannot compensate
3451 above in this case. */
3455 gnu_result
3456 = build_cond_expr
3459 gnu_rhs,
3463 gnu_result);
3464 }
3468 {
3471 tree gnu_false
3478 }
3487 /* This case can apply to a boolean or a modular type.
3488 Fall through for a boolean operand since GNU_CODES is set
3489 up to handle this. */
3491 {
3495 gnu_expr);
3497 }
3499 /* ... fall through ... */
3506 else
3515 {
3517 tree gnu_type;
3522 /* The Expression operand can either be an N_Identifier or
3523 Expanded_Name, which must represent a type, or a
3524 N_Qualified_Expression, which contains both the object type and an
3525 initial value for the object. */
3530 {
3531 Entity_Id gnat_desig_type
3543 {
3546 }
3547 else
3548 {
3554 }
3555 }
3556 else
3563 ignore_init_type);
3564 }
3567 /***************************/
3568 /* Chapter 5: Statements: */
3569 /***************************/
3581 /* Get the LHS and RHS of the statement and convert any reference to an
3582 unconstrained array into a reference to the underlying array.
3583 If we are not to do range checking and the RHS is an N_Function_Call,
3584 pass the LHS to the call function. */
3587 /* If the type has a size that overflows, convert this into raise of
3588 Storage_Error: execution shouldn't have gotten here anyway. */
3596 else
3597 {
3598 gnu_rhs
3601 /* If range check is needed, emit code to generate it */
3605 gnu_result
3607 }
3611 {
3614 /* Make the outer COND_EXPR. Avoid non-determinism. */
3623 /* Now make a COND_EXPR for each of the "else if" parts. Put each
3624 into the previous "else" part and point to where to put any
3625 outer "else". Also avoid non-determinism. */
3629 {
3639 }
3642 }
3666 gnu_result
3676 {
3677 /* The gnu function type of the subprogram currently processed. */
3679 /* The return value from the subprogram. */
3681 /* The place to put the return value. */
3682 tree gnu_lhs;
3684 /* If we are dealing with a "return;" from an Ada procedure with
3685 parameters passed by copy in copy out, we need to return a record
3686 containing the final values of these parameters. If the list
3687 contains only one entry, return just that entry.
3689 For a full description of the copy in copy out parameter mechanism,
3690 see the part of the gnat_to_gnu_entity routine dealing with the
3691 translation of subprograms.
3693 But if we have a return label defined, convert this into
3694 a branch to that label. */
3697 {
3701 }
3704 {
3708 else
3709 gnu_ret_val
3712 }
3714 /* If the Ada subprogram is a function, we just need to return the
3715 expression. If the subprogram returns an unconstrained
3716 array, we have to allocate a new version of the result and
3717 return it. If we return by reference, return a pointer. */
3720 {
3721 /* If the current function returns by target pointer and we
3722 are doing a call, pass that target to the call. */
3725 {
3726 gnu_lhs
3731 }
3732 else
3733 {
3737 /* The original return type was unconstrained so dereference
3738 the TARGET pointer in the actual return value's type. */
3739 gnu_lhs
3742 else
3745 /* Do not remove the padding from GNU_RET_VAL if the inner
3746 type is self-referential since we want to allocate the fixed
3747 size in that case. */
3751 && (TYPE_IS_PADDING_P
3753 && (CONTAINS_PLACEHOLDER_P
3759 gnu_ret_val
3763 {
3766 /* We have two cases: either the function returns with
3767 depressed stack or not. If not, we allocate on the
3768 secondary stack. If so, we allocate in the stack frame.
3769 if no copy is needed, the front end will set By_Ref,
3770 which we handle in the case above. */
3772 gnu_ret_val
3774 gnu_ret_val,
3777 else
3778 gnu_ret_val
3780 gnu_ret_val,
3785 }
3786 }
3787 }
3788 else
3789 /* If the Ada subprogram is a regular procedure, just return. */
3793 {
3799 }
3802 }
3810 /****************************/
3811 /* Chapter 6: Subprograms: */
3812 /****************************/
3815 /* Unless there is a freeze node, declare the subprogram. We consider
3816 this a "definition" even though we're not generating code for
3817 the subprogram because we will be making the corresponding GCC
3818 node here. */
3827 /* This subprogram doesn't exist for code generation purposes, but we
3828 have to elaborate the types of any parameters and result, unless
3829 they are imported types (nothing to generate in this case). */
3831 /* Process the parameter types first. */
3834 = First_Formal_With_Extras
3843 /* Then the result type, set to Standard_Void_Type for procedures. */
3845 {
3846 Entity_Id gnat_temp_type
3851 }
3857 /* For a child unit identifier go up a level to get the
3858 specification. We get this when we try to find the spec of
3859 a child unit package that is the compilation unit being compiled. */
3873 /*************************/
3874 /* Chapter 7: Packages: */
3875 /*************************/
3891 /* If this is the body of a generic package - do nothing */
3893 {
3896 }
3907 /*********************************/
3908 /* Chapter 8: Visibility Rules: */
3909 /*********************************/
3913 /* Nothing to do here - but these may appear in list of declarations */
3917 /***********************/
3918 /* Chapter 9: Tasks: */
3919 /***********************/
3930 /***********************************************************/
3931 /* Chapter 10: Program Structure and Compilation Issues: */
3932 /***********************************************************/
3936 /* This is not called for the main unit, which is handled in function
3937 gigi above. */
3949 /* Simply process whatever unit is being inserted. */
3957 /***************************/
3958 /* Chapter 11: Exceptions: */
3959 /***************************/
3962 /* If there is an At_End procedure attached to this node, and the EH
3963 mechanism is SJLJ, we must have at least a corresponding At_End
3964 handler, unless the No_Exception_Handlers restriction is set. */
3979 else
3984 /*******************************/
3985 /* Chapter 12: Generic Units: */
3986 /*******************************/
3996 /* These nodes can appear on a declaration list but there is nothing to
3997 to be done with them. */
4001 /***************************************************/
4002 /* Chapter 13: Representation Clauses and */
4003 /* Implementation-Dependent Features: */
4004 /***************************************************/
4010 /* The only one we need deal with is for 'Address. For the others, SEM
4011 puts the information elsewhere. We need only deal with 'Address
4012 if the object has a Freeze_Node (which it never will currently). */
4017 /* Get the value to use as the address and save it as the
4018 equivalent for GNAT_TEMP. When the object is frozen,
4019 gnat_to_gnu_entity will do the right thing. */
4027 /* We do nothing with these. SEM puts the information elsewhere. */
4033 {
4043 /* First retrieve the 3 operand lists built by the front-end. */
4046 {
4053 }
4057 {
4064 }
4068 gnu_clobbers
4071 gnu_clobbers);
4073 /* Then perform some standard checking and processing on the
4074 operands. In particular, mark them addressable if needed. */
4079 oconstraints
4083 {
4085 constraint
4091 {
4092 /* If the operand is going to end up in memory,
4093 mark it addressable. Note that we don't test
4094 allows_mem like in the input case below; this
4095 is modelled on the C front-end. */
4099 }
4100 else
4104 }
4107 {
4109 constraint
4115 {
4116 /* If the operand is going to end up in memory,
4117 mark it addressable. */
4121 }
4122 else
4126 }
4132 }
4133 else
4138 /***************************************************/
4139 /* Added Nodes */
4140 /***************************************************/
4158 {
4161 tree gnu_obj_type;
4163 tree gnu_obj_size;
4166 /* If this is a thin pointer, we must dereference it to create
4167 a fat pointer, then go back below to a thin pointer. The
4168 reason for this is that we need a fat pointer someplace in
4169 order to properly compute the size. */
4173 gnu_ptr));
4175 /* If this is an unconstrained array, we know the object must
4176 have been allocated with the template in front of the object.
4177 So pass the template address, but get the total size. Do this
4178 by converting to a thin pointer. */
4180 gnu_ptr
4182 (TYPE_OBJECT_RECORD_TYPE
4184 gnu_ptr);
4189 {
4190 gnu_actual_obj_type
4194 gnu_actual_obj_type
4196 gnu_actual_obj_type,
4198 }
4199 else
4207 {
4210 tree gnu_byte_offset
4217 }
4222 gnat_node);
4223 }
4230 {
4233 }
4236 gnu_result
4239 /* If the type is VOID, this is a statement, so we need to
4240 generate the code for the call. Handle a Condition, if there
4241 is one. */
4243 {
4250 }
4251 else
4256 /* If the result is a pointer type, see if we are either converting
4257 from a non-pointer or from a pointer to a type with a different
4258 alias set and warn if so. If the result defined in the same unit as
4259 this unchecked conversion, we can allow this because we can know to
4260 make that type have alias set 0. */
4261 {
4272 {
4273 post_error_ne
4276 post_error
4278 gnat_node);
4279 post_error_ne
4282 }
4284 /* The No_Strict_Aliasing flag is not propagated to the back-end for
4285 fat pointers so unconditionally warn in problematic cases. */
4287 {
4288 tree array_type
4295 {
4296 post_error_ne
4299 post_error
4301 gnat_node);
4302 }
4303 }
4304 }
4317 }
4319 /* If we pushed our level as part of processing the elaboration routine,
4320 pop it back now. */
4322 {
4327 }
4329 /* Set the location information into the result. Note that we may have
4330 no result if we tried to build a CALL_EXPR node to a procedure with
4331 no side-effects and optimization is enabled. */
4335 /* If we're supposed to return something of void_type, it means we have
4336 something we're elaborating for effect, so just return. */
4340 /* If the result is a constant that overflows, raise constraint error. */
4343 {
4346 gnu_result
4349 }
4351 /* If our result has side-effects and is of an unconstrained type,
4352 make a SAVE_EXPR so that we can be sure it will only be referenced
4353 once. Note we must do this before any conversions. */
4359 /* Now convert the result to the proper type. If the type is void or if
4360 we have no result, return error_mark_node to show we have no result.
4361 If the type of the result is correct or if we have a label (which doesn't
4362 have any well-defined type), return our result. Also don't do the
4363 conversion if the "desired" type involves a PLACEHOLDER_EXPR in its size
4364 since those are the cases where the front end may have the type wrong due
4365 to "instantiating" the unconstrained record with discriminant values
4366 or if this is a FIELD_DECL. If this is the Name of an assignment
4367 statement or a parameter of a procedure call, return what we have since
4368 the RHS has to be converted to our type there in that case, unless
4369 GNU_RESULT_TYPE has a simpler size. Similarly, if the two types are
4370 record types with the same name, the expression type has integral mode,
4371 and GNU_RESULT_TYPE BLKmode, don't convert. This will be the case when
4372 we are converting from a packable type to its actual type and we need
4373 those conversions to be NOPs in order for assignments into these types to
4374 work properly if the inner object is a bitfield and hence can't have
4375 its address taken. Finally, don't convert integral types that are the
4376 operand of an unchecked conversion since we need to ignore those
4377 conversions (for 'Valid). Otherwise, convert the result to the proper
4378 type. */
4398 && (CONTAINS_PLACEHOLDER_P
4402 {
4403 /* In this case remove padding only if the inner object is of
4404 self-referential size: in that case it must be an object of
4405 unconstrained type with a default discriminant. In other cases,
4406 we want to avoid copying too much data. */
4413 gnu_result);
4414 }
4430 {
4431 /* Remove any padding record, but do nothing more in this case. */
4435 gnu_result);
4436 }
4444 /* We don't need any NOP_EXPR or NON_LVALUE_EXPR on GNU_RESULT. */
4451 }
4452 \f
4453 /* Record the current code position in GNAT_NODE. */
4455 static void
4457 {
4462 }
4464 /* Insert the code for GNAT_NODE at the position saved for that node. */
4466 static void
4468 {
4471 }
4472 \f
4473 /* Start a new statement group chained to the previous group. */
4475 static void
4477 {
4480 /* First see if we can get one from the free list. */
4483 else
4489 }
4491 /* Add GNU_STMT to the current statement group. */
4493 void
4495 {
4497 }
4499 /* Similar, but set the location of GNU_STMT to that of GNAT_NODE. */
4501 void
4503 {
4507 }
4509 /* Add a declaration statement for GNU_DECL to the current statement group.
4510 Get SLOC from Entity_Id. */
4512 void
4514 {
4518 /* If this is a variable that Gigi is to ignore, we may have been given
4519 an ERROR_MARK. So test for it. We also might have been given a
4520 reference for a renaming. So only do something for a decl. Also
4521 ignore a TYPE_DECL for an UNCONSTRAINED_ARRAY_TYPE. */
4529 /* If we are global, we don't want to actually output the DECL_EXPR for
4530 this decl since we already have evaluated the expressions in the
4531 sizes and positions as globals and doing it again would be wrong. */
4533 {
4534 /* Mark everything as used to prevent node sharing with subprograms.
4535 Note that walk_tree knows how to handle TYPE_DECL, but neither
4536 VAR_DECL nor CONST_DECL. This appears to be somewhat arbitrary. */
4540 {
4544 }
4545 }
4546 else
4549 /* If this is a variable and an initializer is attached to it, it must be
4550 valid for the context. Similar to init_const in create_var_decl_1. */
4557 {
4558 /* If GNU_DECL has a padded type, convert it to the unpadded
4559 type so the assignment is done properly. */
4562 else
4569 {
4572 }
4575 }
4576 }
4578 /* Utility function to mark nodes with TREE_VISITED and types as having their
4579 sized gimplified. Called from walk_tree. We use this to indicate all
4580 variable sizes and positions in global types may not be shared by any
4581 subprogram. */
4583 static tree
4585 {
4589 /* Don't mark a dummy type as visited because we want to mark its sizes
4590 and fields once it's filled in. */
4598 }
4600 /* Utility function to unshare expressions wrapped up in a SAVE_EXPR. */
4602 static tree
4605 {
4612 }
4614 /* Add GNU_CLEANUP, a cleanup action, to the current code group. */
4616 static void
4618 {
4620 }
4622 /* Set the BLOCK node corresponding to the current code group to GNU_BLOCK. */
4624 void
4626 {
4629 }
4631 /* Return code corresponding to the current code group. It is normally
4632 a STATEMENT_LIST, but may also be a BIND_EXPR or TRY_FINALLY_EXPR if
4633 BLOCK or cleanups were set. */
4635 static tree
4637 {
4641 /* If this is a null list, allocate a new STATEMENT_LIST. Then, if there
4642 are cleanups, make a TRY_FINALLY_EXPR. Last, if there is a BLOCK,
4643 make a BIND_EXPR. Note that we nest in that because the cleanup may
4644 reference variables in the block. */
4656 /* Remove this group from the stack and add it to the free list. */
4662 }
4664 /* Add a list of statements from GNAT_LIST, a possibly-empty list of
4665 statements.*/
4667 static void
4669 {
4670 Node_Id gnat_node;
4676 }
4678 /* Build a tree from GNAT_LIST, a possibly-empty list of statements.
4679 If BINDING_P is true, push and pop a binding level around the list. */
4681 static tree
4683 {
4693 }
4694 \f
4695 /* Push and pop routines for stacks. We keep a free list around so we
4696 don't waste tree nodes. */
4698 static void
4700 {
4704 {
4709 }
4710 else
4714 }
4716 static void
4718 {
4724 }
4725 \f
4726 /* GNU_STMT is a statement. We generate code for that statement. */
4728 void
4730 {
4731 #if 0
4733 #endif
4736 {
4737 #if 0
4739 /* First write a volatile ASM_INPUT to prevent anything from being
4740 moved. */
4746 modifier);
4749 #endif
4753 }
4754 }
4755 \f
4756 /* Generate GIMPLE in place for the expression at *EXPR_P. */
4758 int
4760 {
4762 tree op;
4768 {
4770 /* If this is for a scalar, just make a VAR_DECL for it. If for
4771 an aggregate, get a null pointer of the appropriate type and
4772 dereference it. */
4776 integer_zero_node));
4777 else
4778 {
4781 }
4787 /* We should only do this if we are just elaborating for side-effects,
4788 but we can't know that yet. */
4795 /* If we're taking the address of a constant CONSTRUCTOR, force it to
4796 be put into static memory. We know it's going to be readonly given
4797 the semantics we have and it's required to be static memory in
4798 the case when the reference is in an elaboration procedure. */
4800 {
4811 }
4813 /* If we are taking the address of a SAVE_EXPR, we are typically
4814 processing a misaligned argument to be passed by reference in a
4815 procedure call. We just mark the operand as addressable + not
4816 readonly here and let the common gimplifier code perform the
4817 temporary creation, initialization, and "instantiation" in place of
4818 the SAVE_EXPR in further operands, in particular in the copy back
4819 code inserted after the call. */
4821 {
4824 }
4826 /* Otherwise, if we are taking the address of something that is neither
4827 reference, declaration, or constant, make a variable for the operand
4828 here and then take its address. If we don't do it this way, we may
4829 confuse the gimplifier because it needs to know the variable is
4830 addressable at this point. This duplicates code in
4831 internal_get_tmp_var, which is unfortunate. */
4835 {
4848 }
4853 /* We have a kludge here. If the FIELD_DECL is from a fat pointer and is
4854 from an early dummy type, replace it with the proper FIELD_DECL. */
4857 {
4861 }
4863 /* ... fall through ... */
4867 }
4868 }
4870 /* Generate GIMPLE in place for the statement at *STMT_P. */
4872 static enum gimplify_status
4874 {
4878 {
4888 {
4892 /* Set to emit the statements of the loop. */
4895 /* We first emit the start label and then a conditional jump to
4896 the end label if there's a top condition, then the body of the
4897 loop, then a conditional branch to the end label, then the update,
4898 if any, and finally a jump to the start label and the definition
4899 of the end label. */
4901 gnu_start_label),
4902 stmt_p);
4909 void_type_node,
4910 gnu_end_label)),
4911 stmt_p);
4920 void_type_node,
4921 gnu_end_label)),
4922 stmt_p);
4928 gnu_start_label),
4929 stmt_p);
4931 gnu_end_label),
4932 stmt_p);
4934 }
4937 /* Build a statement to jump to the corresponding end label, then
4938 see if it needs to be conditional. */
4947 }
4948 }
4949 \f
4950 /* Force references to each of the entities in packages withed by GNAT_NODE.
4951 Operate recursively but check that we aren't elaborating something more
4952 than once.
4954 This routine is exclusively called in type_annotate mode, to compute DDA
4955 information for types in withed units, for ASIS use. */
4957 static void
4959 {
4962 /* Process each unit only once. As we trace the context of all relevant
4963 units transitively, including generic bodies, we may encounter the
4964 same generic unit repeatedly. */
4968 /* Save entities in all context units. A body may have an implicit_with
4969 on its own spec, if the context includes a child unit, so don't save
4970 the spec twice. */
4977 {
4981 {
4998 }
5000 {
5001 Node_Id gnat_body
5004 /* Retrieve compilation unit node of generic body. */
5009 /* If body is available, elaborate its context. */
5012 }
5013 }
5017 }
5018 \f
5019 /* Do the processing of N_Freeze_Entity, GNAT_NODE. */
5021 static void
5023 {
5025 tree gnu_old;
5026 tree gnu_new;
5027 tree gnu_init
5032 /* If this is a package, need to generate code for the package. */
5034 {
5035 insert_code_for
5039 }
5041 /* Check for old definition after the above call. This Freeze_Node
5042 might be for one its Itypes. */
5043 gnu_old
5046 /* If this entity has an Address representation clause, GNU_OLD is the
5047 address, so discard it here. */
5051 /* Don't do anything for class-wide types they are always
5052 transformed into their root type. */
5058 /* Don't do anything for subprograms that may have been elaborated before
5059 their freeze nodes. This can happen, for example because of an inner call
5060 in an instance body, or a previous compilation of a spec for inlining
5061 purposes. */
5066 || (gnu_old
5071 /* If we have a non-dummy type old tree, we have nothing to do, except
5072 aborting if this is the public view of a private type whose full view was
5073 not delayed, as this node was never delayed as it should have been. We
5074 let this happen for concurrent types and their Corresponding_Record_Type,
5075 however, because each might legitimately be elaborated before it's own
5076 freeze node, e.g. while processing the other. */
5080 {
5088 }
5090 /* Reset the saved tree, if any, and elaborate the object or type for real.
5091 If there is a full declaration, elaborate it and copy the type to
5092 GNAT_ENTITY. Likewise if this is the record subtype corresponding to
5093 a class wide type or subtype. */
5095 {
5104 }
5108 {
5111 /* Propagate back-annotations from full view to partial view. */
5121 /* The above call may have defined this entity (the simplest example
5122 of this is when we have a private enumeral type since the bounds
5123 will have the public view. */
5129 }
5130 else
5133 /* If we've made any pointers to the old version of this type, we
5134 have to update them. */
5138 }
5139 \f
5140 /* Process the list of inlined subprograms of GNAT_NODE, which is an
5141 N_Compilation_Unit. */
5143 static void
5145 {
5146 Entity_Id gnat_entity;
5147 Node_Id gnat_body;
5149 /* If we can inline, generate RTL for all the inlined subprograms.
5150 Define the entity first so we set DECL_EXTERNAL. */
5155 {
5159 {
5160 /* ??? This really should always be Present. */
5164 gnat_body
5166 }
5169 {
5172 }
5173 }
5174 }
5175 \f
5176 /* Elaborate decls in the lists GNAT_DECLS and GNAT_DECLS2, if present.
5177 We make two passes, one to elaborate anything other than bodies (but
5178 we declare a function if there was no spec). The second pass
5179 elaborates the bodies.
5181 GNAT_END_LIST gives the element in the list past the end. Normally,
5182 this is Empty, but can be First_Real_Statement for a
5183 Handled_Sequence_Of_Statements.
5185 We make a complete pass through both lists if PASS1P is true, then make
5186 the second pass over both lists if PASS2P is true. The lists usually
5187 correspond to the public and private parts of a package. */
5189 static void
5192 {
5194 Node_Id gnat_decl;
5204 {
5205 /* For package specs, we recurse inside the declarations,
5206 thus taking the two pass approach inside the boundary. */
5214 /* Similarly for any declarations in the actions of a
5215 freeze node. */
5217 {
5220 }
5222 /* Package bodies with freeze nodes get their elaboration deferred
5223 until the freeze node, but the code must be placed in the right
5224 place, so record the code position now. */
5232 (Corresponding_Spec
5235 record_code_position
5238 /* We defer most subprogram bodies to the second pass. */
5240 {
5242 {
5248 }
5249 }
5250 /* For bodies and stubs that act as their own specs, the entity
5251 itself must be elaborated in the first pass, because it may
5252 be used in other declarations. */
5254 {
5255 Node_Id gnat_subprog_id =
5262 }
5264 /* Concurrent stubs stand for the corresponding subprogram bodies,
5265 which are deferred like other bodies. */
5268 ;
5269 else
5271 }
5273 /* Here we elaborate everything we deferred above except for package bodies,
5274 which are elaborated at their freeze nodes. Note that we must also
5275 go inside things (package specs and freeze nodes) the first pass did. */
5281 {
5297 }
5298 }
5299 \f
5300 /* Emit code for a range check. GNU_EXPR is the expression to be checked,
5301 GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against
5302 which we have to check. */
5304 static tree
5306 {
5312 /* If GNU_EXPR has an integral type that is narrower than GNU_RANGE_TYPE,
5313 we can't do anything since we might be truncating the bounds. No
5314 check is needed in this case. */
5320 /* Checked expressions must be evaluated only once. */
5323 /* There's no good type to use here, so we might as well use
5324 integer_type_node. Note that the form of the check is
5325 (not (expr >= lo)) or (not (expr <= hi))
5326 the reason for this slightly convoluted form is that NaN's
5327 are not considered to be in range in the float case. */
5328 return emit_check
5330 invert_truthvalue
5334 invert_truthvalue
5338 gnu_high)))),
5340 }
5341 \f
5342 /* Emit code for an index check. GNU_ARRAY_OBJECT is the array object
5343 which we are about to index, GNU_EXPR is the index expression to be
5344 checked, GNU_LOW and GNU_HIGH are the lower and upper bounds
5345 against which GNU_EXPR has to be checked. Note that for index
5346 checking we cannot use the emit_range_check function (although very
5347 similar code needs to be generated in both cases) since for index
5348 checking the array type against which we are checking the indeces
5349 may be unconstrained and consequently we need to retrieve the
5350 actual index bounds from the array object itself
5351 (GNU_ARRAY_OBJECT). The place where we need to do that is in
5352 subprograms having unconstrained array formal parameters */
5354 static tree
5356 tree gnu_expr,
5357 tree gnu_low,
5358 tree gnu_high)
5359 {
5360 tree gnu_expr_check;
5362 /* Checked expressions must be evaluated only once. */
5365 /* Must do this computation in the base type in case the expression's
5366 type is an unsigned subtypes. */
5369 /* If GNU_LOW or GNU_HIGH are a PLACEHOLDER_EXPR, qualify them by
5370 the object we are handling. */
5374 /* There's no good type to use here, so we might as well use
5375 integer_type_node. */
5376 return emit_check
5379 gnu_expr_check,
5381 gnu_low)),
5383 gnu_expr_check,
5385 gnu_high))),
5387 }
5388 \f
5389 /* GNU_COND contains the condition corresponding to an access, discriminant or
5390 range check of value GNU_EXPR. Build a COND_EXPR that returns GNU_EXPR if
5391 GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true.
5392 REASON is the code that says why the exception was raised. */
5394 static tree
5396 {
5397 tree gnu_call;
5398 tree gnu_result;
5402 /* Use an outer COMPOUND_EXPR to make sure that GNU_EXPR will get evaluated
5403 in front of the comparison in case it ends up being a SAVE_EXPR. Put the
5404 whole thing inside its own SAVE_EXPR so the inner SAVE_EXPR doesn't leak
5405 out. */
5409 gnu_expr));
5411 /* If GNU_EXPR has side effects, make the outer COMPOUND_EXPR and
5412 protect it. Otherwise, show GNU_RESULT has no side effects: we
5413 don't need to evaluate it just for the check. */
5415 gnu_result
5417 else
5420 /* ??? Unfortunately, if we don't put a SAVE_EXPR around this whole thing,
5421 we will repeatedly do the test. It would be nice if GCC was able
5422 to optimize this and only do it once. */
5424 }
5425 \f
5426 /* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing
5427 overflow checks if OVERFLOW_P is nonzero and range checks if
5428 RANGE_P is nonzero. GNAT_TYPE is known to be an integral type.
5429 If TRUNCATE_P is nonzero, do a float to integer conversion with
5430 truncation; otherwise round. */
5432 static tree
5435 {
5442 /* If we are not doing any checks, the output is an integral type, and
5443 the input is not a floating type, just do the conversion. This
5444 shortcut is required to avoid problems with packed array types
5445 and simplifies code in all cases anyway. */
5450 /* First convert the expression to its base type. This
5451 will never generate code, but makes the tests below much simpler.
5452 But don't do this if converting from an integer type to an unconstrained
5453 array type since then we need to get the bounds from the original
5454 (unpacked) type. */
5458 /* If overflow checks are requested, we need to be sure the result will
5459 fit in the output base type. But don't do this if the input
5460 is integer and the output floating-point. */
5463 {
5464 /* Ensure GNU_EXPR only gets evaluated once. */
5472 /* Convert the lower bounds to signed types, so we're sure we're
5473 comparing them properly. Likewise, convert the upper bounds
5474 to unsigned types. */
5488 /* Check each bound separately and only if the result bound
5489 is tighter than the bound on the input type. Note that all the
5490 types are base types, so the bounds must be constant. Also,
5491 the comparison is done in the base type of the input, which
5492 always has the proper signedness. First check for input
5493 integer (which means output integer), output float (which means
5494 both float), or mixed, in which case we always compare.
5495 Note that we have to do the comparison which would *fail* in the
5496 case of an error since if it's an FP comparison and one of the
5497 values is a NaN or Inf, the comparison will fail. */
5504 gnu_cond
5505 = invert_truthvalue
5508 gnu_out_lb)));
5516 gnu_cond
5518 invert_truthvalue
5520 gnu_input,
5522 gnu_out_ub))));
5526 CE_Overflow_Check_Failed);
5527 }
5529 /* Now convert to the result base type. If this is a non-truncating
5530 float-to-integer conversion, round. */
5533 {
5539 /* The following calculations depend on proper rounding to even
5540 of each arithmetic operation. In order to prevent excess
5541 precision from spoiling this property, use the widest hardware
5542 floating-point type.
5544 FIXME: For maximum efficiency, this should only be done for machines
5545 and types where intermediates may have extra precision. */
5548 /* FIXME: Should not have padding in the first place */
5553 /* Compute the exact value calc_type'Pred (0.5) at compile time. */
5557 half_minus_pred_half);
5560 /* If the input is strictly negative, subtract this value
5561 and otherwise add it from the input. For 0.5, the result
5562 is exactly between 1.0 and the machine number preceding 1.0
5563 (for calc_type). Since the last bit of 1.0 is even, this 0.5
5564 will round to 1.0, while all other number with an absolute
5565 value less than 0.5 round to 0.0. For larger numbers exactly
5566 halfway between integers, rounding will always be correct as
5567 the true mathematical result will be closer to the higher
5568 integer compared to the lower one. So, this constant works
5569 for all floating-point numbers.
5571 The reason to use the same constant with subtract/add instead
5572 of a positive and negative constant is to allow the comparison
5573 to be scheduled in parallel with retrieval of the constant and
5574 conversion of the input to the calc_type (if necessary).
5575 */
5582 gnu_add_pred_half
5584 gnu_subtract_pred_half
5588 }
5594 else
5597 /* Finally, do the range check if requested. Note that if the
5598 result type is a modular type, the range check is actually
5599 an overflow check. */
5607 }
5608 \f
5609 /* Return 1 if GNU_EXPR can be directly addressed. This is the case unless
5610 it is an expression involving computation or if it involves a reference
5611 to a bitfield or to a field not sufficiently aligned for its type. */
5613 static bool
5615 {
5617 {
5622 /* All DECLs are addressable: if they are in a register, we can force
5623 them to memory. */
5635 && (!STRICT_ALIGNMENT
5636 /* If the field was marked as "semantically" addressable
5637 in create_field_decl, we are guaranteed that it can
5638 be directly addressed. */
5640 /* Otherwise it can nevertheless be directly addressed
5641 if it has been sufficiently aligned in the record. */
5656 {
5657 /* This is addressable if we can avoid a copy. */
5671 }
5675 }
5676 }
5677 \f
5678 /* Do the processing for the declaration of a GNAT_ENTITY, a type. If
5679 a separate Freeze node exists, delay the bulk of the processing. Otherwise
5680 make a GCC type for GNAT_ENTITY and set up the correspondence. */
5682 void
5684 {
5685 tree gnu_old
5687 tree gnu_new;
5689 /* If we are to delay elaboration of this type, just do any
5690 elaborations needed for expressions within the declaration and
5691 make a dummy type entry for this node and its Full_View (if
5692 any) in case something points to it. Don't do this if it
5693 has already been done (the only way that can happen is if
5694 the private completion is also delayed). */
5700 {
5704 {
5713 }
5716 }
5718 /* If we saved away a dummy type for this node it means that this
5719 made the type that corresponds to the full type of an incomplete
5720 type. Clear that type for now and then update the type in the
5721 pointers. */
5723 {
5728 }
5730 /* Now fully elaborate the type. */
5734 /* If we have an old type and we've made pointers to this type,
5735 update those pointers. */
5740 /* If this is a record type corresponding to a task or protected type
5741 that is a completion of an incomplete type, perform a similar update
5742 on the type. */
5743 /* ??? Including protected types here is a guess. */
5748 {
5749 tree gnu_task_old
5759 }
5760 }
5761 \f
5762 /* GNAT_ENTITY is the type of the resulting constructors,
5763 GNAT_ASSOC is the front of the Component_Associations of an N_Aggregate,
5764 and GNU_TYPE is the GCC type of the corresponding record.
5766 Return a CONSTRUCTOR to build the record. */
5768 static tree
5770 {
5773 /* We test for GNU_FIELD being empty in the case where a variant
5774 was the last thing since we don't take things off GNAT_ASSOC in
5775 that case. We check GNAT_ASSOC in case we have a variant, but it
5776 has no fields. */
5780 {
5785 /* The expander is supposed to put a single component selector name
5786 in every record component association */
5789 /* Ignore fields that have Corresponding_Discriminants since we'll
5790 be setting that field in the parent. */
5795 /* Also ignore discriminants of Unchecked_Unions. */
5800 /* Before assigning a value in an aggregate make sure range checks
5801 are done if required. Then convert to the type of the field. */
5807 /* Add the field and expression to the list. */
5809 }
5813 #ifdef ENABLE_CHECKING
5814 {
5815 tree gnu_field;
5817 /* Verify every enty in GNU_LIST was used. */
5820 }
5821 #endif
5824 }
5826 /* Builds a possibly nested constructor for array aggregates. GNAT_EXPR
5827 is the first element of an array aggregate. It may itself be an
5828 aggregate (an array or record aggregate). GNU_ARRAY_TYPE is the gnu type
5829 corresponding to the array aggregate. GNAT_COMPONENT_TYPE is the type
5830 of the array component. It is needed for range checking. */
5832 static tree
5834 Entity_Id gnat_component_type)
5835 {
5838 tree gnu_expr;
5841 {
5842 /* If the expression is itself an array aggregate then first build the
5843 innermost constructor if it is part of our array (multi-dimensional
5844 case). */
5851 gnat_component_type);
5852 else
5853 {
5856 /* before assigning the element to the array make sure it is
5857 in range */
5860 }
5862 gnu_expr_list
5864 gnu_expr_list);
5867 }
5870 }
5871 \f
5872 /* Subroutine of assoc_to_constructor: VALUES is a list of field associations,
5873 some of which are from RECORD_TYPE. Return a CONSTRUCTOR consisting
5874 of the associations that are from RECORD_TYPE. If we see an internal
5875 record, make a recursive call to fill it in as well. */
5877 static tree
5879 {
5884 {
5887 /* _Parent is an internal field, but may have values in the aggregate,
5888 so check for values first. */
5890 {
5893 }
5896 {
5901 }
5902 else
5903 /* If we have a record subtype, the names will match, but not the
5904 actual FIELD_DECLs. */
5907 {
5910 }
5916 }
5919 }
5920 \f
5921 /* EXP is to be treated as an array or record. Handle the cases when it is
5922 an access object and perform the required dereferences. */
5924 static tree
5926 {
5927 /* If the type is a pointer, dereference it. */
5932 /* If we got a padded type, remove it too. */
5938 }
5939 \f
5940 /* Protect EXP from multiple evaluation. This may make a SAVE_EXPR. */
5942 tree
5944 {
5947 /* If this has no side effects, we don't need to do anything. */
5951 /* If it is a conversion, protect what's inside the conversion.
5952 Similarly, if we're indirectly referencing something, we only
5953 actually need to protect the address since the data itself can't
5954 change in these situations. */
5963 /* If EXP is a fat pointer or something that can be placed into a register,
5964 just make a SAVE_EXPR. */
5968 /* Otherwise, dereference, protect the address, and re-reference. */
5969 else
5970 return
5974 exp)));
5975 }
5976 \f
5977 /* This is equivalent to stabilize_reference in GCC's tree.c, but we know how
5978 to handle our new nodes and we take extra arguments:
5980 FORCE says whether to force evaluation of everything,
5982 SUCCESS we set to true unless we walk through something we don't know how
5983 to stabilize, or through something which is not an lvalue and LVALUES_ONLY
5984 is true, in which cases we set to false. */
5986 tree
5989 {
5992 tree result;
5994 /* Assume we'll success unless proven otherwise. */
5998 {
6002 /* No action is needed in this case. */
6006 /* A standalone ADDR_EXPR is never an lvalue, and this one can't
6007 be nested inside an outer INDIRECT_REF, since INDIREC_REF goes
6008 straight to stabilize_1. */
6012 /* ... Fallthru ... */
6019 result
6029 force));
6044 force),
6046 force));
6055 force),
6062 force),
6070 /* ... Fallthru to failure ... */
6072 /* If arg isn't a kind of lvalue we recognize, make no change.
6073 Caller should recognize the error for an invalid lvalue. */
6075 failure:
6078 }
6082 /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS attached to the initial
6083 expression may not be sustained across some paths, such as the way via
6084 build1 for INDIRECT_REF. We re-populate those flags here for the general
6085 case, which is consistent with the GCC version of this routine.
6087 Special care should be taken regarding TREE_SIDE_EFFECTS, because some
6088 paths introduce side effects where there was none initially (e.g. calls
6089 to save_expr), and we also want to keep track of that. */
6095 }
6097 /* Wrapper around maybe_stabilize_reference, for common uses without
6098 lvalue restrictions and without need to examine the success
6099 indication. */
6101 tree
6103 {
6106 }
6108 /* Similar to stabilize_reference_1 in tree.c, but supports an extra
6109 arg to force a SAVE_EXPR for everything. */
6111 static tree
6113 {
6116 tree result;
6118 /* We cannot ignore const expressions because it might be a reference
6119 to a const array but whose index contains side-effects. But we can
6120 ignore things that are actual constant or that already have been
6121 handled by this function. */
6127 {
6136 /* If this is a COMPONENT_REF of a fat pointer, save the entire
6137 fat pointer. This may be more efficient, but will also allow
6138 us to more easily find the match for the PLACEHOLDER_EXPR. */
6143 force),
6147 else
6152 /* Constants need no processing. In fact, we should never reach
6153 here. */
6157 /* Recursively stabilize each operand. */
6161 force));
6165 /* Recursively stabilize each operand. */
6168 force));
6173 }
6180 }
6181 \f
6184 /* Convert Sloc into *LOCUS (a location_t). Return true if this Sloc
6185 corresponds to a source code location and false if it doesn't. In the
6186 latter case, we don't update *LOCUS. We also set the Gigi global variable
6187 REF_FILENAME to the reference file name as given by sinput (i.e no
6188 directory). */
6190 bool
6192 {
6193 /* If node not from source code, ignore. */
6197 /* Use the identifier table to make a hashed, permanent copy of the filename,
6198 since the name table gets reallocated after Gigi returns but before all
6199 the debugging information is output. The __gnat_to_canonical_file_spec
6200 call translates filenames from pragmas Source_Reference that contain host
6201 style syntax not understood by gdb. */
6202 locus->file
6203 = IDENTIFIER_POINTER
6204 (get_identifier
6205 (__gnat_to_canonical_file_spec
6210 ref_filename
6211 = IDENTIFIER_POINTER
6212 (get_identifier
6216 }
6218 /* Similar to annotate_with_locus, but start with the Sloc of GNAT_NODE and
6219 don't do anything if it doesn't correspond to a source location. */
6221 static void
6223 {
6224 location_t locus;
6230 }
6231 \f
6232 /* Post an error message. MSG is the error message, properly annotated.
6233 NODE is the node at which to post the error and the node to use for the
6234 "&" substitution. */
6236 void
6238 {
6239 String_Template temp;
6240 Fat_Pointer fp;
6246 }
6248 /* Similar, but NODE is the node at which to post the error and ENT
6249 is the node to use for the "&" substitution. */
6251 void
6253 {
6254 String_Template temp;
6255 Fat_Pointer fp;
6261 }
6263 /* Similar, but NODE is the node at which to post the error, ENT is the node
6264 to use for the "&" substitution, and N is the number to use for the ^. */
6266 void
6268 {
6269 String_Template temp;
6270 Fat_Pointer fp;
6278 }
6279 \f
6280 /* Similar to post_error_ne_num, but T is a GCC tree representing the
6281 number to write. If the tree represents a constant that fits within
6282 a host integer, the text inside curly brackets in MSG will be output
6283 (presumably including a '^'). Otherwise that text will not be output
6284 and the text inside square brackets will be output instead. */
6286 void
6288 {
6291 Fat_Pointer fp;
6299 #if HOST_BITS_PER_WIDE_INT > HOST_BITS_PER_INT
6300 &&
6301 compare_tree_int
6303 #endif
6304 )
6305 {
6308 }
6309 else
6313 {
6319 ;
6320 else
6322 }
6329 }
6331 /* Similar to post_error_ne_tree, except that NUM is a second
6332 integer to write in the message. */
6334 void
6336 Node_Id node,
6337 Entity_Id ent,
6338 tree t,
6340 {
6343 }
6344 \f
6345 /* Initialize the table that maps GNAT codes to GCC codes for simple
6346 binary and unary operations. */
6348 void
6350 {
6376 }