| blob | c45dcb98e81afe8a5288c0e01445adc0ba552411 |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E X P _ C H 5 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2015, 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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
68 procedure Build_Formal_Container_Iteration
75 -- Utility to create declarations and loop statement for both forms
76 -- of formal container iterators.
79 -- Determine if the right hand side of assignment N is a type conversion
80 -- which requires a change of representation. Called only for the array
81 -- and record cases.
84 -- N is an assignment which assigns an array value. This routine process
85 -- the various special cases and checks required for such assignments,
86 -- including change of representation. Rhs is normally simply the right
87 -- hand side of the assignment, except that if the right hand side is a
88 -- type conversion or a qualified expression, then the RHS is the actual
89 -- expression inside any such type conversions or qualifications.
91 function Expand_Assign_Array_Loop
99 -- N is an assignment statement which assigns an array value. This routine
100 -- expands the assignment into a loop (or nested loops for the case of a
101 -- multi-dimensional array) to do the assignment component by component.
102 -- Larray and Rarray are the entities of the actual arrays on the left
103 -- hand and right hand sides. L_Type and R_Type are the types of these
104 -- arrays (which may not be the same, due to either sliding, or to a
105 -- change of representation case). Ndim is the number of dimensions and
106 -- the parameter Rev indicates if the loops run normally (Rev = False),
107 -- or reversed (Rev = True). The value returned is the constructed
108 -- loop statement. Auxiliary declarations are inserted before node N
109 -- using the standard Insert_Actions mechanism.
112 -- N is an assignment of an untagged record value. This routine handles
113 -- the case where the assignment must be made component by component,
114 -- either because the target is not byte aligned, or there is a change
115 -- of representation, or when we have a tagged type with a representation
116 -- clause (this last case is required because holes in the tagged type
117 -- might be filled with components from child types).
120 -- Use the primitives specified in an Iterable aspect to expand a loop
121 -- over a so-called formal container, primarily for SPARK usage.
124 -- Same, for an iterator of the form " For E of C". In this case the
125 -- iterator provides the name of the element, and the cursor is generated
126 -- internally.
129 -- Expand loop over arrays and containers that uses the form "for X of C"
130 -- with an optional subtype mark, or "for Y in C".
133 -- Expand loop over arrays that uses the form "for X of C"
136 -- Expand for loop over predicated subtype
139 -- Generate the necessary code for controlled and tagged assignment, that
140 -- is to say, finalization of the target before, adjustment of the target
141 -- after and save and restore of the tag and finalization pointers which
142 -- are not 'part of the value' and must not be changed upon assignment. N
143 -- is the original Assignment node.
145 --------------------------------------
146 -- Build_Formal_Container_iteration --
147 --------------------------------------
149 procedure Build_Formal_Container_Iteration
156 is
167 begin
168 -- Declaration for Cursor
170 Init :=
174 Expression =>
180 -- Statement that advances cursor in loop
182 Advance :=
185 Expression =>
192 -- Iterator is rewritten as a while_loop
194 New_Loop :=
196 Iteration_Scheme =>
198 Condition =>
208 ------------------------------
209 -- Change_Of_Representation --
210 ------------------------------
214 begin
215 return
217 and then
221 -------------------------
222 -- Expand_Assign_Array --
223 -------------------------
225 -- There are two issues here. First, do we let Gigi do a block move, or
226 -- do we expand out into a loop? Second, we need to set the two flags
227 -- Forwards_OK and Backwards_OK which show whether the block move (or
228 -- corresponding loops) can be legitimately done in a forwards (low to
229 -- high) or backwards (high to low) manner.
255 -- This switch is set to True if the array move must be done using
256 -- an explicit front end generated loop.
259 -- If the argument is an access to an array, and the assignment is
260 -- converted into a procedure call, apply explicit dereference.
263 -- Test if Exp is a reference to an array whose declaration has
264 -- an address clause, or it is a slice of such an array.
267 -- Test if Exp is a reference to an array which is either a formal
268 -- parameter or a slice of a formal parameter. These are the cases
269 -- where hidden aliasing can occur.
272 -- Determine if Exp is a reference to an array variable which is other
273 -- than an object defined in the current scope, or a slice of such
274 -- an object. Such objects can be aliased to parameters (unlike local
275 -- array references).
277 -----------------------
278 -- Apply_Dereference --
279 -----------------------
283 begin
291 ------------------------
292 -- Has_Address_Clause --
293 ------------------------
296 begin
297 return
300 or else
304 ---------------------
305 -- Is_Formal_Array --
306 ---------------------
309 begin
310 return
312 or else
316 ------------------------
317 -- Is_Non_Local_Array --
318 ------------------------
321 begin
328 -- Determine if Lhs, Rhs are formal arrays or nonlocal arrays
336 -- Start of processing for Expand_Assign_Array
338 begin
339 -- Deal with length check. Note that the length check is done with
340 -- respect to the right hand side as given, not a possible underlying
341 -- renamed object, since this would generate incorrect extra checks.
345 -- We start by assuming that the move can be done in either direction,
346 -- i.e. that the two sides are completely disjoint.
351 -- Normally it is only the slice case that can lead to overlap, and
352 -- explicit checks for slices are made below. But there is one case
353 -- where the slice can be implicit and invisible to us: when we have a
354 -- one dimensional array, and either both operands are parameters, or
355 -- one is a parameter (which can be a slice passed by reference) and the
356 -- other is a non-local variable. In this case the parameter could be a
357 -- slice that overlaps with the other operand.
359 -- However, if the array subtype is a constrained first subtype in the
360 -- parameter case, then we don't have to worry about overlap, since
361 -- slice assignments aren't possible (other than for a slice denoting
362 -- the whole array).
364 -- Note: No overlap is possible if there is a change of representation,
365 -- so we can exclude this case.
368 and then not Crep
369 and then
371 or else
373 or else
375 and then
379 -- In the case of compiling for the Java or .NET Virtual Machine,
380 -- slices are always passed by making a copy, so we don't have to
381 -- worry about overlap. We also want to prevent generation of "<"
382 -- comparisons for array addresses, since that's a meaningless
383 -- operation on the VM.
386 then
390 -- Note: the bit-packed case is not worrisome here, since if we have
391 -- a slice passed as a parameter, it is always aligned on a byte
392 -- boundary, and if there are no explicit slices, the assignment
393 -- can be performed directly.
396 -- If either operand has an address clause clear Backwards_OK and
397 -- Forwards_OK, since we cannot tell if the operands overlap. We
398 -- exclude this treatment when Rhs is an aggregate, since we know
399 -- that overlap can't occur.
403 then
408 -- We certainly must use a loop for change of representation and also
409 -- we use the operand of the conversion on the right hand side as the
410 -- effective right hand side (the component types must match in this
411 -- situation).
418 -- We require a loop if the left side is possibly bit unaligned
421 or else
423 then
426 -- Arrays with controlled components are expanded into a loop to force
427 -- calls to Adjust at the component level.
432 -- If object is atomic, we cannot tolerate a loop
435 or else
437 then
440 -- Loop is required if we have atomic components since we have to
441 -- be sure to do any accesses on an element by element basis.
447 then
450 -- Case where no slice is involved
454 -- The following code deals with the case of unconstrained bit packed
455 -- arrays. The problem is that the template for such arrays contains
456 -- the bounds of the actual source level array, but the copy of an
457 -- entire array requires the bounds of the underlying array. It would
458 -- be nice if the back end could take care of this, but right now it
459 -- does not know how, so if we have such a type, then we expand out
460 -- into a loop, which is inefficient but works correctly. If we don't
461 -- do this, we get the wrong length computed for the array to be
462 -- moved. The two cases we need to worry about are:
464 -- Explicit dereference of an unconstrained packed array type as in
465 -- the following example:
467 -- procedure C52 is
468 -- type BITS is array(INTEGER range <>) of BOOLEAN;
469 -- pragma PACK(BITS);
470 -- type A is access BITS;
471 -- P1,P2 : A;
472 -- begin
473 -- P1 := new BITS (1 .. 65_535);
474 -- P2 := new BITS (1 .. 65_535);
475 -- P2.ALL := P1.ALL;
476 -- end C52;
478 -- A formal parameter reference with an unconstrained bit array type
479 -- is the other case we need to worry about (here we assume the same
480 -- BITS type declared above):
482 -- procedure Write_All (File : out BITS; Contents : BITS);
483 -- begin
484 -- File.Storage := Contents;
485 -- end Write_All;
487 -- We expand to a loop in either of these two cases
489 -- Question for future thought. Another potentially more efficient
490 -- approach would be to create the actual subtype, and then do an
491 -- unchecked conversion to this actual subtype ???
496 -- Function to perform required test for the first case, above
497 -- (dereference of an unconstrained bit packed array).
499 -----------------------
500 -- Is_UBPA_Reference --
501 -----------------------
508 begin
512 then
521 else
523 return
528 else
533 -- Start of processing for Check_Unconstrained_Bit_Packed_Array
535 begin
537 or else
539 then
542 -- Here if we do not have the case of a reference to a bit packed
543 -- unconstrained array case. In this case gigi can most certainly
544 -- handle the assignment if a forwards move is allowed.
546 -- (could it handle the backwards case also???)
553 -- The back end can always handle the assignment if the right side is a
554 -- string literal (note that overlap is definitely impossible in this
555 -- case). If the type is packed, a string literal is always converted
556 -- into an aggregate, except in the case of a null slice, for which no
557 -- aggregate can be written. In that case, rewrite the assignment as a
558 -- null statement, a length check has already been emitted to verify
559 -- that the range of the left-hand side is empty.
561 -- Note that this code is not executed if we have an assignment of a
562 -- string literal to a non-bit aligned component of a record, a case
563 -- which cannot be handled by the backend.
568 then
575 -- If either operand is bit packed, then we need a loop, since we can't
576 -- be sure that the slice is byte aligned. Similarly, if either operand
577 -- is a possibly unaligned slice, then we need a loop (since the back
578 -- end cannot handle unaligned slices).
584 then
587 -- If we are not bit-packed, and we have only one slice, then no overlap
588 -- is possible except in the parameter case, so we can let the back end
589 -- handle things.
597 -- If the right-hand side is a string literal, introduce a temporary for
598 -- it, for use in the generated loop that will follow.
601 declare
605 begin
606 Decl :=
618 -- Come here to complete the analysis
620 -- Loop_Required: Set to True if we know that a loop is required
621 -- regardless of overlap considerations.
623 -- Forwards_OK: Set to False if we already know that a forwards
624 -- move is not safe, else set to True.
626 -- Backwards_OK: Set to False if we already know that a backwards
627 -- move is not safe, else set to True
629 -- Our task at this stage is to complete the overlap analysis, which can
630 -- result in possibly setting Forwards_OK or Backwards_OK to False, and
631 -- then generating the final code, either by deciding that it is OK
632 -- after all to let Gigi handle it, or by generating appropriate code
633 -- in the front end.
635 declare
653 begin
654 -- Get the expressions for the arrays. If we are dealing with a
655 -- private type, then convert to the underlying type. We can do
656 -- direct assignments to an array that is a private type, but we
657 -- cannot assign to elements of the array without this extra
658 -- unchecked conversion.
660 -- Note: We propagate Parent to the conversion nodes to generate
661 -- a well-formed subtree.
665 else
669 declare
671 begin
672 Larray :=
673 Unchecked_Convert_To
682 else
686 declare
688 begin
689 Rarray :=
690 Unchecked_Convert_To
697 -- If both sides are slices, we must figure out whether it is safe
698 -- to do the move in one direction or the other. It is always safe
699 -- if there is a change of representation since obviously two arrays
700 -- with different representations cannot possibly overlap.
706 -- If both left and right hand arrays are entity names, and refer
707 -- to different entities, then we know that the move is safe (the
708 -- two storage areas are completely disjoint).
713 then
716 -- Otherwise, we assume the worst, which is that the two arrays
717 -- are the same array. There is no need to check if we know that
718 -- is the case, because if we don't know it, we still have to
719 -- assume it.
721 -- Generally if the same array is involved, then we have an
722 -- overlapping case. We will have to really assume the worst (i.e.
723 -- set neither of the OK flags) unless we can determine the lower
724 -- or upper bounds at compile time and compare them.
726 else
727 Cresult :=
728 Compile_Time_Compare
732 Cresult :=
733 Compile_Time_Compare
746 -- If after that analysis Loop_Required is False, meaning that we
747 -- have not discovered some non-overlap reason for requiring a loop,
748 -- then the outcome depends on the capabilities of the back end.
752 -- The GCC back end can deal with all cases of overlap by falling
753 -- back to memmove if it cannot use a more efficient approach.
758 -- Assume other back ends can handle it if Forwards_OK is set
763 -- If Forwards_OK is not set, the back end will need something
764 -- like memmove to handle the move. For now, this processing is
765 -- activated using the .s debug flag (-gnatd.s).
772 -- At this stage we have to generate an explicit loop, and we have
773 -- the following cases:
775 -- Forwards_OK = True
777 -- Rnn : right_index := right_index'First;
778 -- for Lnn in left-index loop
779 -- left (Lnn) := right (Rnn);
780 -- Rnn := right_index'Succ (Rnn);
781 -- end loop;
783 -- Note: the above code MUST be analyzed with checks off, because
784 -- otherwise the Succ could overflow. But in any case this is more
785 -- efficient.
787 -- Forwards_OK = False, Backwards_OK = True
789 -- Rnn : right_index := right_index'Last;
790 -- for Lnn in reverse left-index loop
791 -- left (Lnn) := right (Rnn);
792 -- Rnn := right_index'Pred (Rnn);
793 -- end loop;
795 -- Note: the above code MUST be analyzed with checks off, because
796 -- otherwise the Pred could overflow. But in any case this is more
797 -- efficient.
799 -- Forwards_OK = Backwards_OK = False
801 -- This only happens if we have the same array on each side. It is
802 -- possible to create situations using overlays that violate this,
803 -- but we simply do not promise to get this "right" in this case.
805 -- There are two possible subcases. If the No_Implicit_Conditionals
806 -- restriction is set, then we generate the following code:
808 -- declare
809 -- T : constant <operand-type> := rhs;
810 -- begin
811 -- lhs := T;
812 -- end;
814 -- If implicit conditionals are permitted, then we generate:
816 -- if Left_Lo <= Right_Lo then
817 -- <code for Forwards_OK = True above>
818 -- else
819 -- <code for Backwards_OK = True above>
820 -- end if;
822 -- In order to detect possible aliasing, we examine the renamed
823 -- expression when the source or target is a renaming. However,
824 -- the renaming may be intended to capture an address that may be
825 -- affected by subsequent code, and therefore we must recover
826 -- the actual entity for the expansion that follows, not the
827 -- object it renames. In particular, if source or target designate
828 -- a portion of a dynamically allocated object, the pointer to it
829 -- may be reassigned but the renaming preserves the proper location.
832 and then
835 then
840 and then
843 then
847 -- Cases where either Forwards_OK or Backwards_OK is true
854 then
855 declare
860 begin
872 New_Occurrence_Of (
881 else
883 Expand_Assign_Array_Loop
888 -- Case of both are false with No_Implicit_Conditionals
891 declare
895 begin
902 Object_Definition =>
906 Handled_Statement_Sequence =>
914 -- Case of both are false with implicit conditionals allowed
916 else
917 -- Before we generate this code, we must ensure that the left and
918 -- right side array types are defined. They may be itypes, and we
919 -- cannot let them be defined inside the if, since the first use
920 -- in the then may not be executed.
925 -- We normally compare addresses to find out which way round to
926 -- do the loop, since this is reliable, and handles the cases of
927 -- parameters, conversions etc. But we can't do that in the bit
928 -- packed case or the VM case, because addresses don't work there.
931 Condition :=
933 Left_Opnd =>
936 Prefix =>
938 Prefix =>
942 Prefix =>
943 New_Occurrence_Of
948 Right_Opnd =>
951 Prefix =>
953 Prefix =>
957 Prefix =>
958 New_Occurrence_Of
963 -- For the bit packed and VM cases we use the bounds. That's OK,
964 -- because we don't have to worry about parameters, since they
965 -- cannot cause overlap. Perhaps we should worry about weird slice
966 -- conversions ???
968 else
969 -- Copy the bounds
974 -- If the types do not match we add an implicit conversion
975 -- here to ensure proper match
978 Cright_Lo :=
982 -- Reset the Analyzed flag, because the bounds of the index
983 -- type itself may be universal, and must must be reanalyzed
984 -- to acquire the proper type for the back end.
989 Condition :=
999 then
1001 -- Call TSS procedure for array assignment, passing the
1002 -- explicit bounds of right and left hand sides.
1004 declare
1009 begin
1030 else
1036 Expand_Assign_Array_Loop
1041 Expand_Assign_Array_Loop
1050 exception
1055 ------------------------------
1056 -- Expand_Assign_Array_Loop --
1057 ------------------------------
1059 -- The following is an example of the loop generated for the case of a
1060 -- two-dimensional array:
1062 -- declare
1063 -- R2b : Tm1X1 := 1;
1064 -- begin
1065 -- for L1b in 1 .. 100 loop
1066 -- declare
1067 -- R4b : Tm1X2 := 1;
1068 -- begin
1069 -- for L3b in 1 .. 100 loop
1070 -- vm1 (L1b, L3b) := vm2 (R2b, R4b);
1071 -- R4b := Tm1X2'succ(R4b);
1072 -- end loop;
1073 -- end;
1074 -- R2b := Tm1X1'succ(R2b);
1075 -- end loop;
1076 -- end;
1078 -- Here Rev is False, and Tm1Xn are the subscript types for the right hand
1079 -- side. The declarations of R2b and R4b are inserted before the original
1080 -- assignment statement.
1082 function Expand_Assign_Array_Loop
1090 is
1095 -- Entities used as subscripts on left and right sides
1099 -- Left and right index types
1107 -- The increment step for the index of the right-hand side is written
1108 -- as an attribute reference (Succ or Pred). This function returns
1109 -- the corresponding node, which is placed at the end of the loop body.
1111 ----------------
1112 -- Build_Step --
1113 ----------------
1119 begin
1122 else
1126 Step :=
1129 Expression =>
1131 Prefix =>
1137 -- Note that on the last iteration of the loop, the index is increased
1138 -- (or decreased) past the corresponding bound. This is consistent with
1139 -- the C semantics of the back-end, where such an off-by-one value on a
1140 -- dead index variable is OK. However, in CodePeer mode this leads to
1141 -- spurious warnings, and thus we place a guard around the attribute
1142 -- reference. For obvious reasons we only do this for CodePeer.
1145 Step :=
1147 Condition =>
1150 Right_Opnd =>
1160 -- Start of processing for Expand_Assign_Array_Loop
1162 begin
1166 else
1171 -- Setup index types and subscript entities
1173 declare
1177 begin
1193 -- Now construct the assignment statement
1195 declare
1199 begin
1205 Assign :=
1207 Name =>
1211 Expression =>
1216 -- We set assignment OK, since there are some cases, e.g. in object
1217 -- declarations, where we are actually assigning into a constant.
1218 -- If there really is an illegality, it was caught long before now,
1219 -- and was flagged when the original assignment was analyzed.
1223 -- Propagate the No_Ctrl_Actions flag to individual assignments
1228 -- Now construct the loop from the inside out, with the last subscript
1229 -- varying most rapidly. Note that Assign is first the raw assignment
1230 -- statement, and then subsequently the loop that wraps it up.
1233 Assign :=
1238 Object_Definition =>
1240 Expression =>
1245 Handled_Statement_Sequence =>
1249 Iteration_Scheme =>
1251 Loop_Parameter_Specification =>
1255 Discrete_Subtype_Definition =>
1264 --------------------------
1265 -- Expand_Assign_Record --
1266 --------------------------
1273 begin
1274 -- If change of representation, then extract the real right hand side
1275 -- from the type conversion, and proceed with component-wise assignment,
1276 -- since the two types are not the same as far as the back end is
1277 -- concerned.
1282 -- If this may be a case of a large bit aligned component, then proceed
1283 -- with component-wise assignment, to avoid possible clobbering of other
1284 -- components sharing bits in the first or last byte of the component to
1285 -- be assigned.
1288 or
1290 then
1293 -- If we have a tagged type that has a complete record representation
1294 -- clause, we must do we must do component-wise assignments, since child
1295 -- types may have used gaps for their components, and we might be
1296 -- dealing with a view conversion.
1301 -- If neither condition met, then nothing special to do, the back end
1302 -- can handle assignment of the entire component as a single entity.
1304 else
1308 -- At this stage we know that we must do a component wise assignment
1310 declare
1317 function Find_Component
1320 -- Find the component with the given name in the underlying record
1321 -- declaration for Typ. We need to use the actual entity because the
1322 -- type may be private and resolution by identifier alone would fail.
1324 function Make_Component_List_Assign
1327 -- Returns a sequence of statements to assign the components that
1328 -- are referenced in the given component list. The flag U_U is
1329 -- used to force the usage of the inferred value of the variant
1330 -- part expression as the switch for the generated case statement.
1332 function Make_Field_Assign
1335 -- Given C, the entity for a discriminant or component, build an
1336 -- assignment for the corresponding field values. The flag U_U
1337 -- signals the presence of an Unchecked_Union and forces the usage
1338 -- of the inferred discriminant value of C as the right hand side
1339 -- of the assignment.
1342 -- Given CI, a component items list, construct series of statements
1343 -- for fieldwise assignment of the corresponding components.
1345 --------------------
1346 -- Find_Component --
1347 --------------------
1349 function Find_Component
1352 is
1356 begin
1369 --------------------------------
1370 -- Make_Component_List_Assign --
1371 --------------------------------
1373 function Make_Component_List_Assign
1376 is
1387 begin
1404 Statements =>
1409 -- If we have an Unchecked_Union, use the value of the inferred
1410 -- discriminant of the variant part expression as the switch
1411 -- for the case statement. The case statement may later be
1412 -- folded.
1415 Expr :=
1420 else
1421 Expr :=
1424 Selector_Name =>
1437 -----------------------
1438 -- Make_Field_Assign --
1439 -----------------------
1441 function Make_Field_Assign
1444 is
1448 begin
1449 -- In the case of an Unchecked_Union, use the discriminant
1450 -- constraint value as on the right hand side of the assignment.
1453 Expr :=
1457 else
1458 Expr :=
1464 A :=
1466 Name =>
1469 Selector_Name =>
1473 -- Set Assignment_OK, so discriminants can be assigned
1480 then
1487 ------------------------
1488 -- Make_Field_Assigns --
1489 ------------------------
1495 begin
1501 -- Look for components, but exclude _tag field assignment if
1502 -- the special Componentwise_Assignment flag is set.
1507 then
1508 Append_To
1518 -- Start of processing for Expand_Assign_Record
1520 begin
1521 -- Note that we use the base types for this processing. This results
1522 -- in some extra work in the constrained case, but the change of
1523 -- representation case is so unusual that it is not worth the effort.
1525 -- First copy the discriminants. This is done unconditionally. It
1526 -- is required in the unconstrained left side case, and also in the
1527 -- case where this assignment was constructed during the expansion
1528 -- of a type conversion (since initialization of discriminants is
1529 -- suppressed in this case). It is unnecessary but harmless in
1530 -- other cases.
1536 -- If we are expanding the initialization of a derived record
1537 -- that constrains or renames discriminants of the parent, we
1538 -- must use the corresponding discriminant in the parent.
1540 declare
1543 begin
1544 if Inside_Init_Proc
1546 then
1548 else
1554 -- Within an initialization procedure this is the
1555 -- assignment to an unchecked union component, in which
1556 -- case there is no discriminant to initialize.
1561 else
1562 -- The assignment is part of a conversion from a
1563 -- derived unchecked union type with an inferable
1564 -- discriminant, to a parent type.
1569 else
1578 -- We know the underlying type is a record, but its current view
1579 -- may be private. We must retrieve the usable record declaration.
1582 N_Private_Extension_Declaration)
1584 then
1586 else
1596 then
1600 else
1601 Insert_Actions
1610 -----------------------------------
1611 -- Expand_N_Assignment_Statement --
1612 -----------------------------------
1614 -- This procedure implements various cases where an assignment statement
1615 -- cannot just be passed on to the back end in untransformed state.
1625 begin
1626 -- Special case to check right away, if the Componentwise_Assignment
1627 -- flag is set, this is a reanalysis from the expansion of the primitive
1628 -- assignment procedure for a tagged type, and all we need to do is to
1629 -- expand to assignment of components, because otherwise, we would get
1630 -- infinite recursion (since this looks like a tagged assignment which
1631 -- would normally try to *call* the primitive assignment procedure).
1638 -- Defend against invalid subscripts on left side if we are in standard
1639 -- validity checking mode. No need to do this if we are checking all
1640 -- subscripts.
1642 -- Note that we do this right away, because there are some early return
1643 -- paths in this procedure, and this is required on all paths.
1645 if Validity_Checks_On
1646 and then Validity_Check_Default
1647 and then not Validity_Check_Subscripts
1648 then
1652 -- Ada 2005 (AI-327): Handle assignment to priority of protected object
1654 -- Rewrite an assignment to X'Priority into a run-time call
1656 -- For example: X'Priority := New_Prio_Expr;
1657 -- ...is expanded into Set_Ceiling (X._Object, New_Prio_Expr);
1659 -- Note that although X'Priority is notionally an object, it is quite
1660 -- deliberately not defined as an aliased object in the RM. This means
1661 -- that it works fine to rewrite it as a call, without having to worry
1662 -- about complications that would other arise from X'Priority'Access,
1663 -- which is illegal, because of the lack of aliasing.
1666 declare
1673 begin
1674 -- Handle chains of renamings
1680 loop
1684 -- The attribute Priority applied to protected objects has been
1685 -- previously expanded into a call to the Get_Ceiling run-time
1686 -- subprogram.
1690 or else
1692 then
1693 -- Look for the enclosing concurrent type
1702 -- Generate the first actual of the call
1709 -- Select the appropriate run-time call
1712 RT_Subprg_Name :=
1714 else
1715 RT_Subprg_Name :=
1719 Call :=
1733 -- Deal with assignment checks unless suppressed
1737 -- First deal with generation of range check if required
1743 -- Then generate predicate check if required
1748 -- Check for a special case where a high level transformation is
1749 -- required. If we have either of:
1751 -- P.field := rhs;
1752 -- P (sub) := rhs;
1754 -- where P is a reference to a bit packed array, then we have to unwind
1755 -- the assignment. The exact meaning of being a reference to a bit
1756 -- packed array is as follows:
1758 -- An indexed component whose prefix is a bit packed array is a
1759 -- reference to a bit packed array.
1761 -- An indexed component or selected component whose prefix is a
1762 -- reference to a bit packed array is itself a reference ot a
1763 -- bit packed array.
1765 -- The required transformation is
1767 -- Tnn : prefix_type := P;
1768 -- Tnn.field := rhs;
1769 -- P := Tnn;
1771 -- or
1773 -- Tnn : prefix_type := P;
1774 -- Tnn (subscr) := rhs;
1775 -- P := Tnn;
1777 -- Since P is going to be evaluated more than once, any subscripts
1778 -- in P must have their evaluation forced.
1782 then
1783 declare
1789 begin
1790 -- Insert the post assignment first, because we want to copy the
1791 -- BPAR_Expr tree before it gets analyzed in the context of the
1792 -- pre assignment. Note that we do not analyze the post assignment
1793 -- yet (we cannot till we have completed the analysis of the pre
1794 -- assignment). As usual, the analysis of this post assignment
1795 -- will happen on its own when we "run into" it after finishing
1796 -- the current assignment.
1803 -- At this stage BPAR_Expr is a reference to a bit packed array
1804 -- where the reference was not expanded in the original tree,
1805 -- since it was on the left side of an assignment. But in the
1806 -- pre-assignment statement (the object definition), BPAR_Expr
1807 -- will end up on the right hand side, and must be reexpanded. To
1808 -- achieve this, we reset the analyzed flag of all selected and
1809 -- indexed components down to the actual indexed component for
1810 -- the packed array.
1813 loop
1816 if Nkind_In
1818 then
1820 else
1825 -- Now we can insert and analyze the pre-assignment
1827 -- If the right-hand side requires a transient scope, it has
1828 -- already been placed on the stack. However, the declaration is
1829 -- inserted in the tree outside of this scope, and must reflect
1830 -- the proper scope for its variable. This awkward bit is forced
1831 -- by the stricter scope discipline imposed by GCC 2.97.
1833 declare
1835 Scope_Is_Transient
1838 begin
1850 Pop_Scope;
1854 -- Now fix up the original assignment and continue processing
1859 -- We do not need to reanalyze that assignment, and we do not need
1860 -- to worry about references to the temporary, but we do need to
1861 -- make sure that the temporary is not marked as a true constant
1862 -- since we now have a generated assignment to it.
1868 -- When we have the appropriate type of aggregate in the expression (it
1869 -- has been determined during analysis of the aggregate by setting the
1870 -- delay flag), let's perform in place assignment and thus avoid
1871 -- creating a temporary.
1880 -- Apply discriminant check if required. If Lhs is an access type to a
1881 -- designated type with discriminants, we must always check. If the
1882 -- type has unknown discriminants, more elaborate processing below.
1886 then
1887 -- Skip discriminant check if change of representation. Will be
1888 -- done when the change of representation is expanded out.
1894 -- If the type is private without discriminants, and the full type
1895 -- has discriminants (necessarily with defaults) a check may still be
1896 -- necessary if the Lhs is aliased. The private discriminants must be
1897 -- visible to build the discriminant constraints.
1899 -- Only an explicit dereference that comes from source indicates
1900 -- aliasing. Access to formals of protected operations and entries
1901 -- create dereferences but are not semantic aliasings.
1907 then
1908 declare
1912 begin
1913 -- In the case of an expander-generated record subtype whose base
1914 -- type still appears private, Typ will have been set to that
1915 -- private type rather than the underlying record type (because
1916 -- Underlying type will have returned the record subtype), so it's
1917 -- necessary to apply Underlying_Type again to the base type to
1918 -- get the record type we need for the discriminant check. Such
1919 -- subtypes can be created for assignments in certain cases, such
1920 -- as within an instantiation passed this kind of private type.
1921 -- It would be good to avoid this special test, but making changes
1922 -- to prevent this odd form of record subtype seems difficult. ???
1934 -- If the Lhs has a private type with unknown discriminants, it may
1935 -- have a full view with discriminants, but those are nameable only
1936 -- in the underlying type, so convert the Rhs to it before potential
1937 -- checking. Convert Lhs as well, otherwise the actual subtype might
1938 -- not be constructible.
1942 then
1947 -- In the access type case, we need the same discriminant check, and
1948 -- also range checks if we have an access to constrained array.
1952 then
1955 -- Skip discriminant check if change of representation. Will be
1956 -- done when the change of representation is expanded out.
1970 declare
1974 begin
1975 C_Es :=
1976 Get_Range_Checks
1978 Target_Typ,
1981 Insert_Range_Checks
1983 N,
1984 Target_Typ,
1986 Lhs);
1991 -- Apply range check for access type case
1996 then
1998 Apply_Range_Check
2002 -- Ada 2005 (AI-231): Generate the run-time check
2008 -- If an actual is an out parameter of a null-excluding access
2009 -- type, there is access check on entry, so we set the flag
2010 -- Suppress_Assignment_Checks on the generated statement to
2011 -- assign the actual to the parameter block, and we do not want
2012 -- to generate an additional check at this point.
2015 then
2019 -- Ada 2012 (AI05-148): Update current accessibility level if Rhs is a
2020 -- stand-alone obj of an anonymous access type.
2025 then
2026 declare
2028 -- Look through renames to find the underlying entity.
2029 -- For assignment to a rename, we don't care about the
2030 -- Enclosing_Dynamic_Scope of the rename declaration.
2032 ----------------
2033 -- Lhs_Entity --
2034 ----------------
2039 begin
2042 -- Renamed_Object must return an Entity_Name here
2043 -- because of preceding "Present (E_E_A (...))" test.
2051 -- Local Declarations
2055 Condition =>
2057 Left_Opnd =>
2059 Right_Opnd =>
2061 Intval =>
2062 Scope_Depth
2063 (Enclosing_Dynamic_Scope
2069 Name =>
2070 New_Occurrence_Of
2071 (Effective_Extra_Accessibility
2073 Expression =>
2076 begin
2085 -- Case of assignment to a bit packed array element. If there is a
2086 -- change of representation this must be expanded into components,
2087 -- otherwise this is a bit-field assignment.
2091 then
2092 -- Normal case, no change of representation
2098 -- Change of representation case
2100 else
2101 -- Generate the following, to force component-by-component
2102 -- assignments in an efficient way. Otherwise each component
2103 -- will require a temporary and two bit-field manipulations.
2105 -- T1 : Elmt_Type;
2106 -- T1 := RhS;
2107 -- Lhs := T1;
2109 declare
2113 begin
2114 Stats :=
2115 New_List (
2118 Object_Definition =>
2133 -- Build-in-place function call case. Note that we're not yet doing
2134 -- build-in-place for user-written assignment statements (the assignment
2135 -- here came from an aggregate.)
2139 then
2144 -- Nothing to do for valuetypes
2145 -- ??? Set_Scope_Is_Transient (False);
2151 then
2156 begin
2157 -- In the controlled case, we ensure that function calls are
2158 -- evaluated before finalizing the target. In all cases, it makes
2159 -- the expansion easier if the side-effects are removed first.
2164 -- Avoid recursion in the mechanism
2168 -- If dispatching assignment, we need to dispatch to _assign
2172 -- If the type is tagged, we may as well use the predefined
2173 -- primitive assignment. This avoids inlining a lot of code
2174 -- and in the class-wide case, the assignment is replaced
2175 -- by a dispatching call to _assign. It is suppressed in the
2176 -- case of assignments created by the expander that correspond
2177 -- to initializations, where we do want to copy the tag
2178 -- (Expand_Ctrl_Actions flag is set False in this case). It is
2179 -- also suppressed if restriction No_Dispatching_Calls is in
2180 -- force because in that case predefined primitives are not
2181 -- generated.
2186 and then Expand_Ctrl_Actions
2187 and then
2189 then
2192 -- This can happen in an instance when the formal is an
2193 -- extension of a limited interface, and the actual is
2194 -- limited. This is an error according to AI05-0087, but
2195 -- is not caught at the point of instantiation in earlier
2196 -- versions.
2198 -- This is wrong, error messages cannot be issued during
2199 -- expansion, since they would be missed in -gnatc mode ???
2205 -- Fetch the primitive op _assign and proper type to call it.
2206 -- Because of possible conflicts between private and full view,
2207 -- fetch the proper type directly from the operation profile.
2209 declare
2214 begin
2215 -- If the assignment is dispatching, make sure to use the
2216 -- proper type.
2224 -- In case of assignment to a class-wide tagged type, before
2225 -- the assignment we generate run-time check to ensure that
2226 -- the tags of source and target match.
2232 then
2235 Condition =>
2237 Left_Opnd =>
2240 Selector_Name =>
2242 Right_Opnd =>
2245 Selector_Name =>
2250 declare
2254 begin
2255 -- In order to dispatch the call to _assign the type of
2256 -- the actuals must match. Add conversion (if required).
2275 else
2278 -- We can't afford to have destructive Finalization Actions in
2279 -- the Self assignment case, so if the target and the source
2280 -- are not obviously different, code is generated to avoid the
2281 -- self assignment case:
2283 -- if lhs'address /= rhs'address then
2284 -- <code for controlled and/or tagged assignment>
2285 -- end if;
2287 -- Skip this if Restriction (No_Finalization) is active
2290 and then Expand_Ctrl_Actions
2292 then
2295 Condition =>
2297 Left_Opnd =>
2302 Right_Opnd =>
2310 -- We need to set up an exception handler for implementing
2311 -- 7.6.1(18). The remaining adjustments are tackled by the
2312 -- implementation of adjust for record_controllers (see
2313 -- s-finimp.adb).
2315 -- This is skipped if we have no finalization
2317 if Expand_Ctrl_Actions
2319 then
2322 Handled_Statement_Sequence =>
2332 Handled_Statement_Sequence =>
2335 -- If no restrictions on aborts, protect the whole assignment
2336 -- for controlled objects as per 9.8(11).
2339 and then Expand_Ctrl_Actions
2340 and then Abort_Allowed
2341 then
2342 declare
2344 New_Internal_Entity
2348 begin
2357 -- Present the Abort_Undefer_Direct function to the backend
2358 -- so that it can inline the call to the function.
2362 Expand_At_End_Handler
2367 -- N has been rewritten to a block statement for which it is
2368 -- known by construction that no checks are necessary: analyze
2369 -- it with all checks suppressed.
2375 -- Array types
2378 declare
2381 begin
2383 N_Qualified_Expression)
2384 loop
2392 -- Record types
2398 -- Scalar types. This is where we perform the processing related to the
2399 -- requirements of (RM 13.9.1(9-11)) concerning the handling of invalid
2400 -- scalar values.
2404 -- Case where right side is known valid
2408 -- Here the right side is valid, so it is fine. The case to deal
2409 -- with is when the left side is a local variable reference whose
2410 -- value is not currently known to be valid. If this is the case,
2411 -- and the assignment appears in an unconditional context, then
2412 -- we can mark the left side as now being valid if one of these
2413 -- conditions holds:
2415 -- The expression of the right side has Do_Range_Check set so
2416 -- that we know a range check will be performed. Note that it
2417 -- can be the case that a range check is omitted because we
2418 -- make the assumption that we can assume validity for operands
2419 -- appearing in the right side in determining whether a range
2420 -- check is required
2422 -- The subtype of the right side matches the subtype of the
2423 -- left side. In this case, even though we have not checked
2424 -- the range of the right side, we know it is in range of its
2425 -- subtype if the expression is valid.
2430 then
2433 then
2438 -- Case where right side may be invalid in the sense of the RM
2439 -- reference above. The RM does not require that we check for the
2440 -- validity on an assignment, but it does require that the assignment
2441 -- of an invalid value not cause erroneous behavior.
2443 -- The general approach in GNAT is to use the Is_Known_Valid flag
2444 -- to avoid the need for validity checking on assignments. However
2445 -- in some cases, we have to do validity checking in order to make
2446 -- sure that the setting of this flag is correct.
2448 else
2449 -- Validate right side if we are validating copies
2451 if Validity_Checks_On
2452 and then Validity_Check_Copies
2453 then
2454 -- Skip this if left hand side is an array or record component
2455 -- and elementary component validity checks are suppressed.
2458 and then not Validity_Check_Components
2459 then
2461 else
2465 -- We can propagate this to the left side where appropriate
2470 then
2474 -- Otherwise check to see what should be done
2476 -- If left side is a local variable, then we just set its flag to
2477 -- indicate that its value may no longer be valid, since we are
2478 -- copying a potentially invalid value.
2483 -- Check for case of a nonlocal variable on the left side which
2484 -- is currently known to be valid. In this case, we simply ensure
2485 -- that the right side is valid. We only play the game of copying
2486 -- validity status for local variables, since we are doing this
2487 -- statically, not by tracing the full flow graph.
2491 then
2492 -- Note: If Validity_Checking mode is set to none, we ignore
2493 -- the Ensure_Valid call so don't worry about that case here.
2497 -- In all other cases, we can safely copy an invalid value without
2498 -- worrying about the status of the left side. Since it is not a
2499 -- variable reference it will not be considered
2500 -- as being known to be valid in any case.
2502 else
2508 exception
2513 ------------------------------
2514 -- Expand_N_Block_Statement --
2515 ------------------------------
2517 -- Encode entity names defined in block statement
2520 begin
2524 -----------------------------
2525 -- Expand_N_Case_Statement --
2526 -----------------------------
2537 begin
2538 -- Check for the situation where we know at compile time which branch
2539 -- will be taken
2544 -- Do not consider controlled objects found in a case statement which
2545 -- actually models a case expression because their early finalization
2546 -- will affect the result of the expression.
2552 -- Move statements from this alternative after the case statement.
2553 -- They are already analyzed, so will be skipped by the analyzer.
2557 -- That leaves the case statement as a shell. So now we can kill all
2558 -- other alternatives in the case statement.
2562 declare
2565 begin
2566 -- Loop through case alternatives, skipping pragmas, and skipping
2567 -- the one alternative that we select (and therefore retain).
2573 then
2585 -- Here if the choice is not determined at compile time
2587 declare
2596 begin
2600 else
2604 -- First step is to worry about possible invalid argument. The RM
2605 -- requires (RM 5.4(13)) that if the result is invalid (e.g. it is
2606 -- outside the base range), then Constraint_Error must be raised.
2608 -- Case of validity check required (validity checks are on, the
2609 -- expression is not known to be valid, and the case statement
2610 -- comes from source -- no need to validity check internally
2611 -- generated case statements).
2617 -- If there is only a single alternative, just replace it with the
2618 -- sequence of statements since obviously that is what is going to
2619 -- be executed in all cases.
2625 -- We still need to evaluate the expression if it has any side
2626 -- effects.
2631 -- Do not consider controlled objects found in a case statement
2632 -- which actually models a case expression because their early
2633 -- finalization will affect the result of the expression.
2641 -- That leaves the case statement as a shell. The alternative that
2642 -- will be executed is reset to a null list. So now we can kill
2643 -- the entire case statement.
2649 -- An optimization. If there are only two alternatives, and only
2650 -- a single choice, then rewrite the whole case statement as an
2651 -- if statement, since this can result in subsequent optimizations.
2652 -- This helps not only with case statements in the source of a
2653 -- simple form, but also with generated code (discriminant check
2654 -- functions in particular).
2656 -- Note: it is OK to do this before expanding out choices for any
2657 -- static predicates, since the if statement processing will handle
2658 -- the static predicate case fine.
2669 -- For TRUE, generate "expression", not expression = true
2673 then
2676 -- For FALSE, generate "expression" and switch then/else
2680 then
2685 -- For a range, generate "expression in range"
2692 then
2693 Cond :=
2698 -- A subtype indication is not a legal operator in a membership
2699 -- test, so retrieve its range.
2702 Cond :=
2705 Right_Opnd =>
2706 Relocate_Node
2709 -- For any other subexpression "expression = value"
2711 else
2712 Cond :=
2718 -- Now rewrite the case as an IF
2730 -- If the last alternative is not an Others choice, replace it with
2731 -- an N_Others_Choice. Note that we do not bother to call Analyze on
2732 -- the modified case statement, since it's only effect would be to
2733 -- compute the contents of the Others_Discrete_Choices which is not
2734 -- needed by the back end anyway.
2736 -- The reason for this is that the back end always needs some default
2737 -- for a switch, so if we have not supplied one in the processing
2738 -- above for validity checking, then we need to supply one here.
2742 Set_Others_Discrete_Choices
2747 -- Deal with possible declarations of controlled objects, and also
2748 -- with rewriting choice sequences for static predicate references.
2753 -- Do not consider controlled objects found in a case statement
2754 -- which actually models a case expression because their early
2755 -- finalization will affect the result of the expression.
2770 -----------------------------
2771 -- Expand_N_Exit_Statement --
2772 -----------------------------
2774 -- The only processing required is to deal with a possible C/Fortran
2775 -- boolean value used as the condition for the exit statement.
2778 begin
2782 ----------------------------------
2783 -- Expand_Formal_Container_Loop --
2784 ----------------------------------
2799 begin
2800 -- The expansion resembles the one for Ada containers, but the
2801 -- primitives mention the domain of iteration explicitly, and
2802 -- function First applied to the container yields a cursor directly.
2804 -- Cursor : Cursor_type := First (Container);
2805 -- while Has_Element (Cursor, Container) loop
2806 -- <original loop statements>
2807 -- Cursor := Next (Container, Cursor);
2808 -- end loop;
2810 Build_Formal_Container_Iteration
2816 -- Build block to capture declaration of cursor entity.
2818 Blk_Nod :=
2821 Handled_Statement_Sequence =>
2829 ------------------------------------------
2830 -- Expand_Formal_Container_Element_Loop --
2831 ------------------------------------------
2855 begin
2856 -- For an element iterator, the Element aspect must be present,
2857 -- (this is checked during analysis) and the expansion takes the form:
2859 -- Cursor : Cursor_type := First (Container);
2860 -- Elmt : Element_Type;
2861 -- while Has_Element (Cursor, Container) loop
2862 -- Elmt := Element (Container, Cursor);
2863 -- <original loop statements>
2864 -- Cursor := Next (Container, Cursor);
2865 -- end loop;
2867 Build_Formal_Container_Iteration
2873 -- Declaration for Element.
2875 Elmt_Decl :=
2880 -- The element is only modified in expanded code, so it appears as
2881 -- unassigned to the warning machinery. We must suppress this spurious
2882 -- warning explicitly.
2886 Elmt_Ref :=
2889 Expression =>
2899 -- The loop is rewritten as a block, to hold the element declaration
2901 New_Loop :=
2904 Handled_Statement_Sequence =>
2910 -- The loop parameter is declared by an object declaration, but within
2911 -- the loop we must prevent user assignments to it, so we analyze the
2912 -- declaration and reset the entity kind, before analyzing the rest of
2913 -- the loop;
2922 -----------------------------
2923 -- Expand_N_Goto_Statement --
2924 -----------------------------
2926 -- Add poll before goto if polling active
2929 begin
2933 ---------------------------
2934 -- Expand_N_If_Statement --
2935 ---------------------------
2937 -- First we deal with the case of C and Fortran convention boolean values,
2938 -- with zero/non-zero semantics.
2940 -- Second, we deal with the obvious rewriting for the cases where the
2941 -- condition of the IF is known at compile time to be True or False.
2943 -- Third, we remove elsif parts which have non-empty Condition_Actions and
2944 -- rewrite as independent if statements. For example:
2946 -- if x then xs
2947 -- elsif y then ys
2948 -- ...
2949 -- end if;
2951 -- becomes
2952 --
2953 -- if x then xs
2954 -- else
2955 -- <<condition actions of y>>
2956 -- if y then ys
2957 -- ...
2958 -- end if;
2959 -- end if;
2961 -- This rewriting is needed if at least one elsif part has a non-empty
2962 -- Condition_Actions list. We also do the same processing if there is a
2963 -- constant condition in an elsif part (in conjunction with the first
2964 -- processing step mentioned above, for the recursive call made to deal
2965 -- with the created inner if, this deals with properly optimizing the
2966 -- cases of constant elsif conditions).
2976 -- Indicates whether we want warnings when we delete branches of the
2977 -- if statement based on constant condition analysis. We never want
2978 -- these warnings for expander generated code.
2980 begin
2981 -- Do not consider controlled objects found in an if statement which
2982 -- actually models an if expression because their early finalization
2983 -- will affect the result of the expression.
2991 -- The following loop deals with constant conditions for the IF. We
2992 -- need a loop because as we eliminate False conditions, we grab the
2993 -- first elsif condition and use it as the primary condition.
2997 -- If condition is True, we can simply rewrite the if statement now
2998 -- by replacing it by the series of then statements.
3002 -- All the else parts can be killed
3012 -- If condition is False, then we can delete the condition and
3013 -- the Then statements
3015 else
3016 -- We do not delete the condition if constant condition warnings
3017 -- are enabled, since otherwise we end up deleting the desired
3018 -- warning. Of course the backend will get rid of this True/False
3019 -- test anyway, so nothing is lost here.
3027 -- If there are no elsif statements, then we simply replace the
3028 -- entire if statement by the sequence of else statements.
3033 then
3036 else
3044 -- If there are elsif statements, the first of them becomes the
3045 -- if/then section of the rebuilt if statement This is the case
3046 -- where we loop to reprocess this copied condition.
3048 else
3054 -- Hed might have been captured as the condition determining
3055 -- the current value for an entity. Now it is detached from
3056 -- the tree, so a Current_Value pointer in the condition might
3057 -- need to be updated.
3068 -- Loop through elsif parts, dealing with constant conditions and
3069 -- possible condition actions that are present.
3075 -- Do not consider controlled objects found in an if statement
3076 -- which actually models an if expression because their early
3077 -- finalization will affect the result of the expression.
3085 -- If there are condition actions, then rewrite the if statement
3086 -- as indicated above. We also do the same rewrite for a True or
3087 -- False condition. The further processing of this constant
3088 -- condition is then done by the recursive call to expand the
3089 -- newly created if statement
3093 then
3094 -- Note this is not an implicit if statement, since it is part
3095 -- of an explicit if statement in the source (or of an implicit
3096 -- if statement that has already been tested).
3098 New_If :=
3105 -- Elsif parts for new if come from remaining elsif's of parent
3130 -- No special processing for that elsif part, move to next
3132 else
3138 -- Some more optimizations applicable if we still have an IF statement
3144 -- Another optimization, special cases that can be simplified
3146 -- if expression then
3147 -- return true;
3148 -- else
3149 -- return false;
3150 -- end if;
3152 -- can be changed to:
3154 -- return expression;
3156 -- and
3158 -- if expression then
3159 -- return false;
3160 -- else
3161 -- return true;
3162 -- end if;
3164 -- can be changed to:
3166 -- return not (expression);
3168 -- Only do these optimizations if we are at least at -O1 level and
3169 -- do not do them if control flow optimizations are suppressed.
3173 then
3179 then
3180 declare
3184 begin
3186 and then
3188 then
3189 declare
3193 begin
3195 and then
3197 then
3200 then
3209 then
3212 Expression =>
3214 Right_Opnd =>
3227 --------------------------
3228 -- Expand_Iterator_Loop --
3229 --------------------------
3245 begin
3246 -- Processing for arrays
3255 else
3262 -- Processing for containers
3264 -- For an "of" iterator the name is a container expression, which
3265 -- is transformed into a call to the default iterator.
3267 -- For an iterator of the form "in" the name is a function call
3268 -- that delivers an iterator type.
3270 -- In both cases, analysis of the iterator has introduced an object
3271 -- declaration to capture the domain, so that Container is an entity.
3273 -- The for loop is expanded into a while loop which uses a container
3274 -- specific cursor to desgnate each element.
3276 -- Iter : Iterator_Type := Container.Iterate;
3277 -- Cursor : Cursor_type := First (Iter);
3278 -- while Has_Element (Iter) loop
3279 -- declare
3280 -- -- The block is added when Element_Type is controlled
3282 -- Obj : Pack.Element_Type := Element (Cursor);
3283 -- -- for the "of" loop form
3284 -- begin
3285 -- <original loop statements>
3286 -- end;
3288 -- Cursor := Iter.Next (Cursor);
3289 -- end loop;
3291 -- If "reverse" is present, then the initialization of the cursor
3292 -- uses Last and the step becomes Prev. Pack is the name of the
3293 -- scope where the container package is instantiated.
3295 declare
3303 begin
3304 -- The type of the iterator is the return type of the Iterate
3305 -- function used. For the "of" form this is the default iterator
3306 -- for the type, otherwise it is the type of the explicit
3307 -- function used in the iterator specification. The most common
3308 -- case will be an Iterate function in the container package.
3310 -- The primitive operations of the container type may not be
3311 -- use-visible, so we introduce the name of the enclosing package
3312 -- in the declarations below. The Iterator type is declared in a
3313 -- an instance within the container package itself.
3315 -- If the container type is a derived type, the cursor type is
3316 -- found in the package of the parent type.
3320 else
3326 -- The "of" case uses an internally generated cursor whose type
3327 -- is found in the container package. The domain of iteration
3328 -- is expanded into a call to the default Iterator function, but
3329 -- this expansion does not take place in quantified expressions
3330 -- that are analyzed with expansion disabled, and in that case the
3331 -- type of the iterator must be obtained from the aspect.
3339 function Get_Default_Iterator
3341 -- If the container is a derived type, the aspect holds the
3342 -- parent operation. The required one is a primitive of the
3343 -- derived type and is either inherited or overridden.
3345 --------------------------
3346 -- Get_Default_Iterator --
3347 --------------------------
3349 function Get_Default_Iterator
3351 is
3357 begin
3360 -- A previous version of GNAT allowed indexing aspects to
3361 -- be redefined on derived container types, while the
3362 -- default iterator was inherited from the aprent type.
3363 -- This non-standard extension is preserved temporarily for
3364 -- use by the modelling project under debug flag d.X.
3369 then
3370 Container_Arg :=
3372 Subtype_Mark =>
3373 New_Occurrence_Of
3382 -- The default iterator must be a primitive operation
3383 -- of the type, at the same dispatch slot position.
3391 then
3398 -- default iterator must exist.
3407 -- Start of processing for Handle_Of
3409 begin
3411 Default_Iter :=
3414 else
3420 -- For an container element iterator, the iterator type
3421 -- is obtained from the corresponding aspect, whose return
3422 -- type is descended from the corresponding interface type
3423 -- in some instance of Ada.Iterator_Interfaces. The actuals
3424 -- of that instantiation are Cursor and Has_Element.
3428 -- The iterator type, which is a class_wide type, may itself
3429 -- be derived locally, so the desired instantiation is the
3430 -- scope of the root type of the iterator type.
3434 -- Rewrite domain of iteration as a call to the default
3435 -- iterator for the container type.
3440 Parameter_Associations =>
3444 -- Find cursor type in proper iterator package, which is an
3445 -- instantiation of Iterator_Interfaces.
3456 -- Generate:
3457 -- Id : Element_Type renames Container (Cursor);
3458 -- This assumes that the container type has an indexing
3459 -- operation with Cursor. The check that this operation
3460 -- exists is performed in Check_Container_Indexing.
3462 Decl :=
3465 Subtype_Mark =>
3467 Name =>
3470 Expressions =>
3473 -- The defining identifier in the iterator is user-visible
3474 -- and must be visible in the debugger.
3478 -- If the container does not have a variable indexing aspect,
3479 -- the element is a constant in the loop.
3483 then
3487 -- If the container holds controlled objects, wrap the loop
3488 -- statements and element renaming declaration with a block.
3489 -- This ensures that the result of Element (Cusor) is
3490 -- cleaned up after each iteration of the loop.
3494 -- Generate:
3495 -- declare
3496 -- Id : Element_Type := Element (curosr);
3497 -- begin
3498 -- <original loop statements>
3499 -- end;
3504 Handled_Statement_Sequence =>
3508 -- Elements do not need finalization
3510 else
3515 -- X in Iterate (S) : type of iterator is type of explicitly
3516 -- given Iterate function, and the loop variable is the cursor.
3517 -- It will be assigned in the loop and must be a variable.
3519 else
3525 -- Determine the advancement and initialization steps for the
3526 -- cursor.
3528 -- Analysis of the expanded loop will verify that the container
3529 -- has a reverse iterator.
3535 else
3540 -- For both iterator forms, add a call to the step operation to
3541 -- advance the cursor. Generate:
3543 -- Cursor := Iterator.Next (Cursor);
3545 -- or else
3547 -- Cursor := Next (Cursor);
3549 declare
3552 begin
3553 Rhs :=
3555 Name =>
3569 -- Generate:
3570 -- while Iterator.Has_Element loop
3571 -- <Stats>
3572 -- end loop;
3574 -- Has_Element is the second actual in the iterator package
3576 New_Loop :=
3578 Iteration_Scheme =>
3580 Condition =>
3582 Name =>
3583 New_Occurrence_Of (
3585 Parameter_Associations =>
3591 -- If present, preserve identifier of loop, which can be used in
3592 -- an exit statement in the body.
3598 -- Create the declarations for Iterator and cursor and insert them
3599 -- before the source loop. Given that the domain of iteration is
3600 -- already an entity, the iterator is just a renaming of that
3601 -- entity. Possible optimization ???
3602 -- Generate:
3604 -- I : Iterator_Type renames Container;
3605 -- C : Cursor_Type := Container.[First | Last];
3613 -- Create declaration for cursor
3615 declare
3618 begin
3619 Decl :=
3622 Object_Definition =>
3624 Expression =>
3627 Selector_Name =>
3630 -- The cursor is only modified in expanded code, so it appears
3631 -- as unassigned to the warning machinery. We must suppress
3632 -- this spurious warning explicitly. The cursor's kind is that of
3633 -- the original loop parameter (it is a constant if the domain of
3634 -- iteration is constant).
3643 -- If the range of iteration is given by a function call that
3644 -- returns a container, the finalization actions have been saved
3645 -- in the Condition_Actions of the iterator. Insert them now at
3646 -- the head of the loop.
3657 -------------------------------------
3658 -- Expand_Iterator_Loop_Over_Array --
3659 -------------------------------------
3674 -- Start of processing for Expand_Iterator_Loop_Over_Array
3676 begin
3677 -- for Element of Array loop
3679 -- This case requires an internally generated cursor to iterate over
3680 -- the array.
3685 -- Generate:
3686 -- Element : Component_Type renames Array (Iterator);
3688 Ind_Comp :=
3696 Subtype_Mark =>
3700 -- Mark the loop variable as needing debug info, so that expansion
3701 -- of the renaming will result in Materialize_Entity getting set via
3702 -- Debug_Renaming_Declaration. (This setting is needed here because
3703 -- the setting in Freeze_Entity comes after the expansion, which is
3704 -- too late. ???)
3708 -- for Index in Array loop
3710 -- This case utilizes the already given iterator name
3712 else
3716 -- Generate:
3718 -- for Iterator in [reverse] Array'Range (Array_Dim) loop
3719 -- Element : Component_Type renames Array (Iterator);
3720 -- <original loop statements>
3721 -- end loop;
3723 Core_Loop :=
3725 Iteration_Scheme =>
3727 Loop_Parameter_Specification =>
3730 Discrete_Subtype_Definition =>
3740 -- Processing for multidimensional array
3746 -- Generate the dimension loops starting from the innermost one
3748 -- for Iterator in [reverse] Array'Range (Array_Dim - Dim) loop
3749 -- <core loop>
3750 -- end loop;
3752 Core_Loop :=
3754 Iteration_Scheme =>
3756 Loop_Parameter_Specification =>
3759 Discrete_Subtype_Definition =>
3769 -- Update the previously created object renaming declaration with
3770 -- the new iterator.
3777 -- Inherit the loop identifier from the original loop. This ensures that
3778 -- the scope stack is consistent after the rewriting.
3788 -----------------------------
3789 -- Expand_N_Loop_Statement --
3790 -----------------------------
3792 -- 1. Remove null loop entirely
3793 -- 2. Deal with while condition for C/Fortran boolean
3794 -- 3. Deal with loops with a non-standard enumeration type range
3795 -- 4. Deal with while loops where Condition_Actions is set
3796 -- 5. Deal with loops over predicated subtypes
3797 -- 6. Deal with loops with iterators over arrays and containers
3798 -- 7. Insert polling call if required
3805 begin
3806 -- Delete null loop
3813 -- Deal with condition for C/Fortran Boolean
3819 -- Generate polling call
3825 -- Nothing more to do for plain loop with no iteration scheme
3830 -- Case of for loop (Loop_Parameter_Specification present)
3832 -- Note: we do not have to worry about validity checking of the for loop
3833 -- range bounds here, since they were frozen with constant declarations
3834 -- and it is during that process that the validity checking is done.
3837 declare
3847 begin
3848 -- Deal with loop over predicates
3852 then
3855 -- Handle the case where we have a for loop with the range type
3856 -- being an enumeration type with non-standard representation.
3857 -- In this case we expand:
3859 -- for x in [reverse] a .. b loop
3860 -- ...
3861 -- end loop;
3863 -- to
3865 -- for xP in [reverse] integer
3866 -- range etype'Pos (a) .. etype'Pos (b)
3867 -- loop
3868 -- declare
3869 -- x : constant etype := Pos_To_Rep (xP);
3870 -- begin
3871 -- ...
3872 -- end;
3873 -- end loop;
3877 then
3878 New_Id :=
3882 -- If the type has a contiguous representation, successive
3883 -- values can be generated as offsets from the first literal.
3886 Expr :=
3889 Left_Opnd =>
3893 else
3894 -- Use the constructed array Enum_Pos_To_Rep
3896 Expr :=
3898 Prefix =>
3900 Expressions =>
3904 -- Build declaration for loop identifier
3906 Decls :=
3907 New_List (
3918 Iteration_Scheme =>
3920 Loop_Parameter_Specification =>
3925 Discrete_Subtype_Definition =>
3928 Subtype_Mark =>
3931 Constraint =>
3933 Range_Expression =>
3936 Low_Bound =>
3938 Prefix =>
3944 Relocate_Node
3947 High_Bound =>
3949 Prefix =>
3955 Relocate_Node
3956 (Type_High_Bound
3962 Handled_Statement_Sequence =>
3968 -- The loop parameter's entity must be removed from the loop
3969 -- scope's entity list and rendered invisible, since it will
3970 -- now be located in the new block scope. Any other entities
3971 -- already associated with the loop scope, such as the loop
3972 -- parameter's subtype, will remain there.
3974 -- In an element loop, the loop will contain a declaration for
3975 -- a cursor variable; otherwise the loop id is the first entity
3976 -- in the scope constructed for the loop.
3992 -- Nothing to do with other cases of for loops
3994 else
3999 -- Second case, if we have a while loop with Condition_Actions set, then
4000 -- we change it into a plain loop:
4002 -- while C loop
4003 -- ...
4004 -- end loop;
4006 -- changed to:
4008 -- loop
4009 -- <<condition actions>>
4010 -- exit when not C;
4011 -- ...
4012 -- end loop
4017 then
4018 declare
4021 begin
4022 ES :=
4024 Condition =>
4031 -- This is not an implicit loop, since it is generated in response
4032 -- to the loop statement being processed. If this is itself
4033 -- implicit, the restriction has already been checked. If not,
4034 -- it is an explicit loop.
4045 -- Here to deal with iterator case
4049 then
4052 -- An iterator loop may generate renaming declarations for elements
4053 -- that require debug information. This is the case in particular
4054 -- with element iterators, where debug information must be generated
4055 -- for the temporary that holds the element value. These temporaries
4056 -- are created within a transient block whose local declarations are
4057 -- transferred to the loop, which now has non-trivial local objects.
4061 then
4066 -- When the iteration scheme mentiones attribute 'Loop_Entry, the loop
4067 -- is transformed into a conditional block where the original loop is
4068 -- the sole statement. Inspect the statements of the nested loop for
4069 -- controlled objects.
4080 ----------------------------
4081 -- Expand_Predicated_Loop --
4082 ----------------------------
4084 -- Note: the expander can handle generation of loops over predicated
4085 -- subtypes for both the dynamic and static cases. Depending on what
4086 -- we decide is allowed in Ada 2012 mode and/or extensions allowed
4087 -- mode, the semantic analyzer may disallow one or both forms.
4098 begin
4099 -- Case of iteration over non-static predicate, should not be possible
4100 -- since this is not allowed by the semantics and should have been
4101 -- caught during analysis of the loop statement.
4106 -- If the predicate list is empty, that corresponds to a predicate of
4107 -- False, in which case the loop won't run at all, and we rewrite the
4108 -- entire loop as a null statement.
4114 -- For expansion over a static predicate we generate the following
4116 -- declare
4117 -- J : Ltype := min-val;
4118 -- begin
4119 -- loop
4120 -- body
4121 -- case J is
4122 -- when endpoint => J := startpoint;
4123 -- when endpoint => J := startpoint;
4124 -- ...
4125 -- when max-val => exit;
4126 -- when others => J := Lval'Succ (J);
4127 -- end case;
4128 -- end loop;
4129 -- end;
4131 -- with min-val replaced by max-val and Succ replaced by Pred if the
4132 -- loop parameter specification carries a Reverse indicator.
4134 -- To make this a little clearer, let's take a specific example:
4136 -- type Int is range 1 .. 10;
4137 -- subtype StaticP is Int with
4138 -- predicate => StaticP in 3 | 10 | 5 .. 7;
4139 -- ...
4140 -- for L in StaticP loop
4141 -- Put_Line ("static:" & J'Img);
4142 -- end loop;
4144 -- In this case, the loop is transformed into
4146 -- begin
4147 -- J : L := 3;
4148 -- loop
4149 -- body
4150 -- case J is
4151 -- when 3 => J := 5;
4152 -- when 7 => J := 10;
4153 -- when 10 => exit;
4154 -- when others => J := L'Succ (J);
4155 -- end case;
4156 -- end loop;
4157 -- end;
4159 else
4168 -- Given static expression or static range, returns an identifier
4169 -- whose value is the low bound of the expression value or range.
4172 -- Given static expression or static range, returns an identifier
4173 -- whose value is the high bound of the expression value or range.
4175 ------------
4176 -- Hi_Val --
4177 ------------
4180 begin
4183 else
4189 ------------
4190 -- Lo_Val --
4191 ------------
4194 begin
4197 else
4203 -- Start of processing for Static_Predicate
4205 begin
4206 -- Convert loop identifier to normal variable and reanalyze it so
4207 -- that this conversion works. We have to use the same defining
4208 -- identifier, since there may be references in the loop body.
4213 -- In most loops the loop variable is assigned in various
4214 -- alternatives in the body. However, in the rare case when
4215 -- the range specifies a single element, the loop variable
4216 -- may trigger a spurious warning that is could be constant.
4217 -- This warning might as well be suppressed.
4221 -- Loop to create branches of case statement
4227 -- Initial value is largest value in predicate.
4229 D :=
4239 else
4240 S :=
4255 else
4257 -- Initial value is smallest value in predicate.
4259 D :=
4269 else
4270 S :=
4286 -- Add others choice
4288 declare
4291 begin
4294 else
4298 S :=
4301 Expression =>
4315 -- Construct case statement and append to body statements
4317 Cstm :=
4323 -- Rewrite the loop
4330 Handled_Statement_Sequence =>
4342 ------------------------------
4343 -- Make_Tag_Ctrl_Assignment --
4344 ------------------------------
4357 and then not Comp_Asn
4360 -- Tags are not saved and restored when VM_Target because VM tags are
4361 -- represented implicitly in objects.
4367 begin
4368 -- Finalize the target of the assignment when controlled
4370 -- We have two exceptions here:
4372 -- 1. If we are in an init proc since it is an initialization more
4373 -- than an assignment.
4375 -- 2. If the left-hand side is a temporary that was not initialized
4376 -- (or the parent part of a temporary since it is the case in
4377 -- extension aggregates). Such a temporary does not come from
4378 -- source. We must examine the original node for the prefix, because
4379 -- it may be a component of an entry formal, in which case it has
4380 -- been rewritten and does not appear to come from source either.
4382 -- Case of init proc
4387 -- The left hand side is an uninitialized temporary object
4392 N_Object_Declaration
4394 then
4397 else
4399 Make_Final_Call
4404 -- Save the Tag in a local variable Tag_Id
4413 Expression =>
4416 Selector_Name =>
4419 -- Otherwise Tag_Id is not used
4421 else
4425 -- Save the Prev and Next fields on .NET/JVM. This is not needed on non
4426 -- VM targets since the fields are not part of the object.
4430 then
4434 -- Generate:
4435 -- Pnn : Root_Controlled_Ptr := Root_Controlled (L).Prev;
4440 Object_Definition =>
4442 Expression =>
4444 Prefix =>
4445 Unchecked_Convert_To
4447 Selector_Name =>
4450 -- Generate:
4451 -- Nnn : Root_Controlled_Ptr := Root_Controlled (L).Next;
4456 Object_Definition =>
4458 Expression =>
4460 Prefix =>
4461 Unchecked_Convert_To
4463 Selector_Name =>
4467 -- If the tagged type has a full rep clause, expand the assignment into
4468 -- component-wise assignments. Mark the node as unanalyzed in order to
4469 -- generate the proper code and propagate this scenario by setting a
4470 -- flag to avoid infinite recursion.
4479 -- Restore the tag
4484 Name =>
4487 Selector_Name =>
4492 -- Restore the Prev and Next fields on .NET/JVM
4496 then
4497 -- Generate:
4498 -- Root_Controlled (L).Prev := Prev_Id;
4502 Name =>
4504 Prefix =>
4505 Unchecked_Convert_To
4507 Selector_Name =>
4511 -- Generate:
4512 -- Root_Controlled (L).Next := Next_Id;
4516 Name =>
4518 Prefix =>
4519 Unchecked_Convert_To
4525 -- Adjust the target after the assignment when controlled (not in the
4526 -- init proc since it is an initialization more than an assignment).
4530 Make_Adjust_Call
4537 exception
4539 -- Could use comment here ???