| blob | 978a1e97c40ff9dc2be3bb55c45b92f0638b64f4 |
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-2014, 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 ------------------------------------------------------------------------------
65 procedure Build_Formal_Container_Iteration
72 -- Utility to create declarations and loop statement for both forms
73 -- of formal container iterators.
76 -- Determine if the right hand side of assignment N is a type conversion
77 -- which requires a change of representation. Called only for the array
78 -- and record cases.
81 -- N is an assignment which assigns an array value. This routine process
82 -- the various special cases and checks required for such assignments,
83 -- including change of representation. Rhs is normally simply the right
84 -- hand side of the assignment, except that if the right hand side is a
85 -- type conversion or a qualified expression, then the RHS is the actual
86 -- expression inside any such type conversions or qualifications.
88 function Expand_Assign_Array_Loop
96 -- N is an assignment statement which assigns an array value. This routine
97 -- expands the assignment into a loop (or nested loops for the case of a
98 -- multi-dimensional array) to do the assignment component by component.
99 -- Larray and Rarray are the entities of the actual arrays on the left
100 -- hand and right hand sides. L_Type and R_Type are the types of these
101 -- arrays (which may not be the same, due to either sliding, or to a
102 -- change of representation case). Ndim is the number of dimensions and
103 -- the parameter Rev indicates if the loops run normally (Rev = False),
104 -- or reversed (Rev = True). The value returned is the constructed
105 -- loop statement. Auxiliary declarations are inserted before node N
106 -- using the standard Insert_Actions mechanism.
109 -- N is an assignment of a untagged record value. This routine handles
110 -- the case where the assignment must be made component by component,
111 -- either because the target is not byte aligned, or there is a change
112 -- of representation, or when we have a tagged type with a representation
113 -- clause (this last case is required because holes in the tagged type
114 -- might be filled with components from child types).
117 -- Use the primitives specified in an Iterable aspect to expand a loop
118 -- over a so-called formal container, primarily for SPARK usage.
121 -- Same, for an iterator of the form " For E of C". In this case the
122 -- iterator provides the name of the element, and the cursor is generated
123 -- internally.
126 -- Expand loop over arrays and containers that uses the form "for X of C"
127 -- with an optional subtype mark, or "for Y in C".
130 -- Expand loop over arrays that uses the form "for X of C"
133 -- Expand for loop over predicated subtype
136 -- Generate the necessary code for controlled and tagged assignment, that
137 -- is to say, finalization of the target before, adjustment of the target
138 -- after and save and restore of the tag and finalization pointers which
139 -- are not 'part of the value' and must not be changed upon assignment. N
140 -- is the original Assignment node.
142 --------------------------------------
143 -- Build_Formal_Container_iteration --
144 --------------------------------------
146 procedure Build_Formal_Container_Iteration
153 is
164 begin
165 -- Declaration for Cursor
167 Init :=
171 Expression =>
177 -- Statement that advances cursor in loop
179 Advance :=
182 Expression =>
189 -- Iterator is rewritten as a while_loop
191 New_Loop :=
193 Iteration_Scheme =>
195 Condition =>
205 ------------------------------
206 -- Change_Of_Representation --
207 ------------------------------
211 begin
212 return
214 and then
218 -------------------------
219 -- Expand_Assign_Array --
220 -------------------------
222 -- There are two issues here. First, do we let Gigi do a block move, or
223 -- do we expand out into a loop? Second, we need to set the two flags
224 -- Forwards_OK and Backwards_OK which show whether the block move (or
225 -- corresponding loops) can be legitimately done in a forwards (low to
226 -- high) or backwards (high to low) manner.
252 -- This switch is set to True if the array move must be done using
253 -- an explicit front end generated loop.
256 -- If the argument is an access to an array, and the assignment is
257 -- converted into a procedure call, apply explicit dereference.
260 -- Test if Exp is a reference to an array whose declaration has
261 -- an address clause, or it is a slice of such an array.
264 -- Test if Exp is a reference to an array which is either a formal
265 -- parameter or a slice of a formal parameter. These are the cases
266 -- where hidden aliasing can occur.
269 -- Determine if Exp is a reference to an array variable which is other
270 -- than an object defined in the current scope, or a slice of such
271 -- an object. Such objects can be aliased to parameters (unlike local
272 -- array references).
274 -----------------------
275 -- Apply_Dereference --
276 -----------------------
280 begin
288 ------------------------
289 -- Has_Address_Clause --
290 ------------------------
293 begin
294 return
297 or else
301 ---------------------
302 -- Is_Formal_Array --
303 ---------------------
306 begin
307 return
309 or else
313 ------------------------
314 -- Is_Non_Local_Array --
315 ------------------------
318 begin
325 -- Determine if Lhs, Rhs are formal arrays or nonlocal arrays
333 -- Start of processing for Expand_Assign_Array
335 begin
336 -- Deal with length check. Note that the length check is done with
337 -- respect to the right hand side as given, not a possible underlying
338 -- renamed object, since this would generate incorrect extra checks.
342 -- We start by assuming that the move can be done in either direction,
343 -- i.e. that the two sides are completely disjoint.
348 -- Normally it is only the slice case that can lead to overlap, and
349 -- explicit checks for slices are made below. But there is one case
350 -- where the slice can be implicit and invisible to us: when we have a
351 -- one dimensional array, and either both operands are parameters, or
352 -- one is a parameter (which can be a slice passed by reference) and the
353 -- other is a non-local variable. In this case the parameter could be a
354 -- slice that overlaps with the other operand.
356 -- However, if the array subtype is a constrained first subtype in the
357 -- parameter case, then we don't have to worry about overlap, since
358 -- slice assignments aren't possible (other than for a slice denoting
359 -- the whole array).
361 -- Note: No overlap is possible if there is a change of representation,
362 -- so we can exclude this case.
365 and then not Crep
366 and then
368 or else
370 or else
372 and then
376 -- In the case of compiling for the Java or .NET Virtual Machine,
377 -- slices are always passed by making a copy, so we don't have to
378 -- worry about overlap. We also want to prevent generation of "<"
379 -- comparisons for array addresses, since that's a meaningless
380 -- operation on the VM.
383 then
387 -- Note: the bit-packed case is not worrisome here, since if we have
388 -- a slice passed as a parameter, it is always aligned on a byte
389 -- boundary, and if there are no explicit slices, the assignment
390 -- can be performed directly.
393 -- If either operand has an address clause clear Backwards_OK and
394 -- Forwards_OK, since we cannot tell if the operands overlap. We
395 -- exclude this treatment when Rhs is an aggregate, since we know
396 -- that overlap can't occur.
400 then
405 -- We certainly must use a loop for change of representation and also
406 -- we use the operand of the conversion on the right hand side as the
407 -- effective right hand side (the component types must match in this
408 -- situation).
415 -- We require a loop if the left side is possibly bit unaligned
418 or else
420 then
423 -- Arrays with controlled components are expanded into a loop to force
424 -- calls to Adjust at the component level.
429 -- If object is atomic, we cannot tolerate a loop
432 or else
434 then
437 -- Loop is required if we have atomic components since we have to
438 -- be sure to do any accesses on an element by element basis.
444 then
447 -- Case where no slice is involved
451 -- The following code deals with the case of unconstrained bit packed
452 -- arrays. The problem is that the template for such arrays contains
453 -- the bounds of the actual source level array, but the copy of an
454 -- entire array requires the bounds of the underlying array. It would
455 -- be nice if the back end could take care of this, but right now it
456 -- does not know how, so if we have such a type, then we expand out
457 -- into a loop, which is inefficient but works correctly. If we don't
458 -- do this, we get the wrong length computed for the array to be
459 -- moved. The two cases we need to worry about are:
461 -- Explicit dereference of an unconstrained packed array type as in
462 -- the following example:
464 -- procedure C52 is
465 -- type BITS is array(INTEGER range <>) of BOOLEAN;
466 -- pragma PACK(BITS);
467 -- type A is access BITS;
468 -- P1,P2 : A;
469 -- begin
470 -- P1 := new BITS (1 .. 65_535);
471 -- P2 := new BITS (1 .. 65_535);
472 -- P2.ALL := P1.ALL;
473 -- end C52;
475 -- A formal parameter reference with an unconstrained bit array type
476 -- is the other case we need to worry about (here we assume the same
477 -- BITS type declared above):
479 -- procedure Write_All (File : out BITS; Contents : BITS);
480 -- begin
481 -- File.Storage := Contents;
482 -- end Write_All;
484 -- We expand to a loop in either of these two cases
486 -- Question for future thought. Another potentially more efficient
487 -- approach would be to create the actual subtype, and then do an
488 -- unchecked conversion to this actual subtype ???
493 -- Function to perform required test for the first case, above
494 -- (dereference of an unconstrained bit packed array).
496 -----------------------
497 -- Is_UBPA_Reference --
498 -----------------------
505 begin
509 then
518 else
520 return
525 else
530 -- Start of processing for Check_Unconstrained_Bit_Packed_Array
532 begin
534 or else
536 then
539 -- Here if we do not have the case of a reference to a bit packed
540 -- unconstrained array case. In this case gigi can most certainly
541 -- handle the assignment if a forwards move is allowed.
543 -- (could it handle the backwards case also???)
550 -- The back end can always handle the assignment if the right side is a
551 -- string literal (note that overlap is definitely impossible in this
552 -- case). If the type is packed, a string literal is always converted
553 -- into an aggregate, except in the case of a null slice, for which no
554 -- aggregate can be written. In that case, rewrite the assignment as a
555 -- null statement, a length check has already been emitted to verify
556 -- that the range of the left-hand side is empty.
558 -- Note that this code is not executed if we have an assignment of a
559 -- string literal to a non-bit aligned component of a record, a case
560 -- which cannot be handled by the backend.
565 then
572 -- If either operand is bit packed, then we need a loop, since we can't
573 -- be sure that the slice is byte aligned. Similarly, if either operand
574 -- is a possibly unaligned slice, then we need a loop (since the back
575 -- end cannot handle unaligned slices).
581 then
584 -- If we are not bit-packed, and we have only one slice, then no overlap
585 -- is possible except in the parameter case, so we can let the back end
586 -- handle things.
594 -- If the right-hand side is a string literal, introduce a temporary for
595 -- it, for use in the generated loop that will follow.
598 declare
602 begin
603 Decl :=
615 -- Come here to complete the analysis
617 -- Loop_Required: Set to True if we know that a loop is required
618 -- regardless of overlap considerations.
620 -- Forwards_OK: Set to False if we already know that a forwards
621 -- move is not safe, else set to True.
623 -- Backwards_OK: Set to False if we already know that a backwards
624 -- move is not safe, else set to True
626 -- Our task at this stage is to complete the overlap analysis, which can
627 -- result in possibly setting Forwards_OK or Backwards_OK to False, and
628 -- then generating the final code, either by deciding that it is OK
629 -- after all to let Gigi handle it, or by generating appropriate code
630 -- in the front end.
632 declare
650 begin
651 -- Get the expressions for the arrays. If we are dealing with a
652 -- private type, then convert to the underlying type. We can do
653 -- direct assignments to an array that is a private type, but we
654 -- cannot assign to elements of the array without this extra
655 -- unchecked conversion.
657 -- Note: We propagate Parent to the conversion nodes to generate
658 -- a well-formed subtree.
662 else
666 declare
668 begin
669 Larray :=
670 Unchecked_Convert_To
679 else
683 declare
685 begin
686 Rarray :=
687 Unchecked_Convert_To
694 -- If both sides are slices, we must figure out whether it is safe
695 -- to do the move in one direction or the other. It is always safe
696 -- if there is a change of representation since obviously two arrays
697 -- with different representations cannot possibly overlap.
703 -- If both left and right hand arrays are entity names, and refer
704 -- to different entities, then we know that the move is safe (the
705 -- two storage areas are completely disjoint).
710 then
713 -- Otherwise, we assume the worst, which is that the two arrays
714 -- are the same array. There is no need to check if we know that
715 -- is the case, because if we don't know it, we still have to
716 -- assume it.
718 -- Generally if the same array is involved, then we have an
719 -- overlapping case. We will have to really assume the worst (i.e.
720 -- set neither of the OK flags) unless we can determine the lower
721 -- or upper bounds at compile time and compare them.
723 else
724 Cresult :=
725 Compile_Time_Compare
729 Cresult :=
730 Compile_Time_Compare
743 -- If after that analysis Loop_Required is False, meaning that we
744 -- have not discovered some non-overlap reason for requiring a loop,
745 -- then the outcome depends on the capabilities of the back end.
749 -- The GCC back end can deal with all cases of overlap by falling
750 -- back to memmove if it cannot use a more efficient approach.
755 -- Assume other back ends can handle it if Forwards_OK is set
760 -- If Forwards_OK is not set, the back end will need something
761 -- like memmove to handle the move. For now, this processing is
762 -- activated using the .s debug flag (-gnatd.s).
769 -- At this stage we have to generate an explicit loop, and we have
770 -- the following cases:
772 -- Forwards_OK = True
774 -- Rnn : right_index := right_index'First;
775 -- for Lnn in left-index loop
776 -- left (Lnn) := right (Rnn);
777 -- Rnn := right_index'Succ (Rnn);
778 -- end loop;
780 -- Note: the above code MUST be analyzed with checks off, because
781 -- otherwise the Succ could overflow. But in any case this is more
782 -- efficient.
784 -- Forwards_OK = False, Backwards_OK = True
786 -- Rnn : right_index := right_index'Last;
787 -- for Lnn in reverse left-index loop
788 -- left (Lnn) := right (Rnn);
789 -- Rnn := right_index'Pred (Rnn);
790 -- end loop;
792 -- Note: the above code MUST be analyzed with checks off, because
793 -- otherwise the Pred could overflow. But in any case this is more
794 -- efficient.
796 -- Forwards_OK = Backwards_OK = False
798 -- This only happens if we have the same array on each side. It is
799 -- possible to create situations using overlays that violate this,
800 -- but we simply do not promise to get this "right" in this case.
802 -- There are two possible subcases. If the No_Implicit_Conditionals
803 -- restriction is set, then we generate the following code:
805 -- declare
806 -- T : constant <operand-type> := rhs;
807 -- begin
808 -- lhs := T;
809 -- end;
811 -- If implicit conditionals are permitted, then we generate:
813 -- if Left_Lo <= Right_Lo then
814 -- <code for Forwards_OK = True above>
815 -- else
816 -- <code for Backwards_OK = True above>
817 -- end if;
819 -- In order to detect possible aliasing, we examine the renamed
820 -- expression when the source or target is a renaming. However,
821 -- the renaming may be intended to capture an address that may be
822 -- affected by subsequent code, and therefore we must recover
823 -- the actual entity for the expansion that follows, not the
824 -- object it renames. In particular, if source or target designate
825 -- a portion of a dynamically allocated object, the pointer to it
826 -- may be reassigned but the renaming preserves the proper location.
829 and then
832 then
837 and then
840 then
844 -- Cases where either Forwards_OK or Backwards_OK is true
851 then
852 declare
857 begin
869 New_Occurrence_Of (
878 else
880 Expand_Assign_Array_Loop
885 -- Case of both are false with No_Implicit_Conditionals
888 declare
892 begin
899 Object_Definition =>
903 Handled_Statement_Sequence =>
911 -- Case of both are false with implicit conditionals allowed
913 else
914 -- Before we generate this code, we must ensure that the left and
915 -- right side array types are defined. They may be itypes, and we
916 -- cannot let them be defined inside the if, since the first use
917 -- in the then may not be executed.
922 -- We normally compare addresses to find out which way round to
923 -- do the loop, since this is reliable, and handles the cases of
924 -- parameters, conversions etc. But we can't do that in the bit
925 -- packed case or the VM case, because addresses don't work there.
928 Condition :=
930 Left_Opnd =>
933 Prefix =>
935 Prefix =>
939 Prefix =>
940 New_Occurrence_Of
945 Right_Opnd =>
948 Prefix =>
950 Prefix =>
954 Prefix =>
955 New_Occurrence_Of
960 -- For the bit packed and VM cases we use the bounds. That's OK,
961 -- because we don't have to worry about parameters, since they
962 -- cannot cause overlap. Perhaps we should worry about weird slice
963 -- conversions ???
965 else
966 -- Copy the bounds
971 -- If the types do not match we add an implicit conversion
972 -- here to ensure proper match
975 Cright_Lo :=
979 -- Reset the Analyzed flag, because the bounds of the index
980 -- type itself may be universal, and must must be reanalyzed
981 -- to acquire the proper type for the back end.
986 Condition :=
996 then
998 -- Call TSS procedure for array assignment, passing the
999 -- explicit bounds of right and left hand sides.
1001 declare
1006 begin
1027 else
1033 Expand_Assign_Array_Loop
1038 Expand_Assign_Array_Loop
1047 exception
1052 ------------------------------
1053 -- Expand_Assign_Array_Loop --
1054 ------------------------------
1056 -- The following is an example of the loop generated for the case of a
1057 -- two-dimensional array:
1059 -- declare
1060 -- R2b : Tm1X1 := 1;
1061 -- begin
1062 -- for L1b in 1 .. 100 loop
1063 -- declare
1064 -- R4b : Tm1X2 := 1;
1065 -- begin
1066 -- for L3b in 1 .. 100 loop
1067 -- vm1 (L1b, L3b) := vm2 (R2b, R4b);
1068 -- R4b := Tm1X2'succ(R4b);
1069 -- end loop;
1070 -- end;
1071 -- R2b := Tm1X1'succ(R2b);
1072 -- end loop;
1073 -- end;
1075 -- Here Rev is False, and Tm1Xn are the subscript types for the right hand
1076 -- side. The declarations of R2b and R4b are inserted before the original
1077 -- assignment statement.
1079 function Expand_Assign_Array_Loop
1087 is
1092 -- Entities used as subscripts on left and right sides
1096 -- Left and right index types
1104 -- The increment step for the index of the right-hand side is written
1105 -- as an attribute reference (Succ or Pred). This function returns
1106 -- the corresponding node, which is placed at the end of the loop body.
1108 ----------------
1109 -- Build_Step --
1110 ----------------
1116 begin
1119 else
1123 Step :=
1126 Expression =>
1128 Prefix =>
1134 -- Note that on the last iteration of the loop, the index is increased
1135 -- (or decreased) past the corresponding bound. This is consistent with
1136 -- the C semantics of the back-end, where such an off-by-one value on a
1137 -- dead index variable is OK. However, in CodePeer mode this leads to
1138 -- spurious warnings, and thus we place a guard around the attribute
1139 -- reference. For obvious reasons we only do this for CodePeer.
1142 Step :=
1144 Condition =>
1147 Right_Opnd =>
1157 -- Start of processing for Expand_Assign_Array_Loop
1159 begin
1163 else
1168 -- Setup index types and subscript entities
1170 declare
1174 begin
1190 -- Now construct the assignment statement
1192 declare
1196 begin
1202 Assign :=
1204 Name =>
1208 Expression =>
1213 -- We set assignment OK, since there are some cases, e.g. in object
1214 -- declarations, where we are actually assigning into a constant.
1215 -- If there really is an illegality, it was caught long before now,
1216 -- and was flagged when the original assignment was analyzed.
1220 -- Propagate the No_Ctrl_Actions flag to individual assignments
1225 -- Now construct the loop from the inside out, with the last subscript
1226 -- varying most rapidly. Note that Assign is first the raw assignment
1227 -- statement, and then subsequently the loop that wraps it up.
1230 Assign :=
1235 Object_Definition =>
1237 Expression =>
1242 Handled_Statement_Sequence =>
1246 Iteration_Scheme =>
1248 Loop_Parameter_Specification =>
1252 Discrete_Subtype_Definition =>
1261 --------------------------
1262 -- Expand_Assign_Record --
1263 --------------------------
1270 begin
1271 -- If change of representation, then extract the real right hand side
1272 -- from the type conversion, and proceed with component-wise assignment,
1273 -- since the two types are not the same as far as the back end is
1274 -- concerned.
1279 -- If this may be a case of a large bit aligned component, then proceed
1280 -- with component-wise assignment, to avoid possible clobbering of other
1281 -- components sharing bits in the first or last byte of the component to
1282 -- be assigned.
1285 or
1287 then
1290 -- If we have a tagged type that has a complete record representation
1291 -- clause, we must do we must do component-wise assignments, since child
1292 -- types may have used gaps for their components, and we might be
1293 -- dealing with a view conversion.
1298 -- If neither condition met, then nothing special to do, the back end
1299 -- can handle assignment of the entire component as a single entity.
1301 else
1305 -- At this stage we know that we must do a component wise assignment
1307 declare
1314 function Find_Component
1317 -- Find the component with the given name in the underlying record
1318 -- declaration for Typ. We need to use the actual entity because the
1319 -- type may be private and resolution by identifier alone would fail.
1321 function Make_Component_List_Assign
1324 -- Returns a sequence of statements to assign the components that
1325 -- are referenced in the given component list. The flag U_U is
1326 -- used to force the usage of the inferred value of the variant
1327 -- part expression as the switch for the generated case statement.
1329 function Make_Field_Assign
1332 -- Given C, the entity for a discriminant or component, build an
1333 -- assignment for the corresponding field values. The flag U_U
1334 -- signals the presence of an Unchecked_Union and forces the usage
1335 -- of the inferred discriminant value of C as the right hand side
1336 -- of the assignment.
1339 -- Given CI, a component items list, construct series of statements
1340 -- for fieldwise assignment of the corresponding components.
1342 --------------------
1343 -- Find_Component --
1344 --------------------
1346 function Find_Component
1349 is
1353 begin
1366 --------------------------------
1367 -- Make_Component_List_Assign --
1368 --------------------------------
1370 function Make_Component_List_Assign
1373 is
1384 begin
1401 Statements =>
1406 -- If we have an Unchecked_Union, use the value of the inferred
1407 -- discriminant of the variant part expression as the switch
1408 -- for the case statement. The case statement may later be
1409 -- folded.
1412 Expr :=
1417 else
1418 Expr :=
1421 Selector_Name =>
1434 -----------------------
1435 -- Make_Field_Assign --
1436 -----------------------
1438 function Make_Field_Assign
1441 is
1445 begin
1446 -- In the case of an Unchecked_Union, use the discriminant
1447 -- constraint value as on the right hand side of the assignment.
1450 Expr :=
1454 else
1455 Expr :=
1461 A :=
1463 Name =>
1466 Selector_Name =>
1470 -- Set Assignment_OK, so discriminants can be assigned
1477 then
1484 ------------------------
1485 -- Make_Field_Assigns --
1486 ------------------------
1492 begin
1498 -- Look for components, but exclude _tag field assignment if
1499 -- the special Componentwise_Assignment flag is set.
1504 then
1505 Append_To
1515 -- Start of processing for Expand_Assign_Record
1517 begin
1518 -- Note that we use the base types for this processing. This results
1519 -- in some extra work in the constrained case, but the change of
1520 -- representation case is so unusual that it is not worth the effort.
1522 -- First copy the discriminants. This is done unconditionally. It
1523 -- is required in the unconstrained left side case, and also in the
1524 -- case where this assignment was constructed during the expansion
1525 -- of a type conversion (since initialization of discriminants is
1526 -- suppressed in this case). It is unnecessary but harmless in
1527 -- other cases.
1533 -- If we are expanding the initialization of a derived record
1534 -- that constrains or renames discriminants of the parent, we
1535 -- must use the corresponding discriminant in the parent.
1537 declare
1540 begin
1541 if Inside_Init_Proc
1543 then
1545 else
1551 -- Within an initialization procedure this is the
1552 -- assignment to an unchecked union component, in which
1553 -- case there is no discriminant to initialize.
1558 else
1559 -- The assignment is part of a conversion from a
1560 -- derived unchecked union type with an inferable
1561 -- discriminant, to a parent type.
1566 else
1575 -- We know the underlying type is a record, but its current view
1576 -- may be private. We must retrieve the usable record declaration.
1579 N_Private_Extension_Declaration)
1581 then
1583 else
1593 then
1597 else
1598 Insert_Actions
1607 -----------------------------------
1608 -- Expand_N_Assignment_Statement --
1609 -----------------------------------
1611 -- This procedure implements various cases where an assignment statement
1612 -- cannot just be passed on to the back end in untransformed state.
1622 begin
1623 -- Special case to check right away, if the Componentwise_Assignment
1624 -- flag is set, this is a reanalysis from the expansion of the primitive
1625 -- assignment procedure for a tagged type, and all we need to do is to
1626 -- expand to assignment of components, because otherwise, we would get
1627 -- infinite recursion (since this looks like a tagged assignment which
1628 -- would normally try to *call* the primitive assignment procedure).
1635 -- Defend against invalid subscripts on left side if we are in standard
1636 -- validity checking mode. No need to do this if we are checking all
1637 -- subscripts.
1639 -- Note that we do this right away, because there are some early return
1640 -- paths in this procedure, and this is required on all paths.
1642 if Validity_Checks_On
1643 and then Validity_Check_Default
1644 and then not Validity_Check_Subscripts
1645 then
1649 -- Ada 2005 (AI-327): Handle assignment to priority of protected object
1651 -- Rewrite an assignment to X'Priority into a run-time call
1653 -- For example: X'Priority := New_Prio_Expr;
1654 -- ...is expanded into Set_Ceiling (X._Object, New_Prio_Expr);
1656 -- Note that although X'Priority is notionally an object, it is quite
1657 -- deliberately not defined as an aliased object in the RM. This means
1658 -- that it works fine to rewrite it as a call, without having to worry
1659 -- about complications that would other arise from X'Priority'Access,
1660 -- which is illegal, because of the lack of aliasing.
1663 declare
1670 begin
1671 -- Handle chains of renamings
1677 loop
1681 -- The attribute Priority applied to protected objects has been
1682 -- previously expanded into a call to the Get_Ceiling run-time
1683 -- subprogram.
1687 or else
1689 then
1690 -- Look for the enclosing concurrent type
1699 -- Generate the first actual of the call
1706 -- Select the appropriate run-time call
1709 RT_Subprg_Name :=
1711 else
1712 RT_Subprg_Name :=
1716 Call :=
1730 -- Deal with assignment checks unless suppressed
1734 -- First deal with generation of range check if required
1740 -- Then generate predicate check if required
1745 -- Check for a special case where a high level transformation is
1746 -- required. If we have either of:
1748 -- P.field := rhs;
1749 -- P (sub) := rhs;
1751 -- where P is a reference to a bit packed array, then we have to unwind
1752 -- the assignment. The exact meaning of being a reference to a bit
1753 -- packed array is as follows:
1755 -- An indexed component whose prefix is a bit packed array is a
1756 -- reference to a bit packed array.
1758 -- An indexed component or selected component whose prefix is a
1759 -- reference to a bit packed array is itself a reference ot a
1760 -- bit packed array.
1762 -- The required transformation is
1764 -- Tnn : prefix_type := P;
1765 -- Tnn.field := rhs;
1766 -- P := Tnn;
1768 -- or
1770 -- Tnn : prefix_type := P;
1771 -- Tnn (subscr) := rhs;
1772 -- P := Tnn;
1774 -- Since P is going to be evaluated more than once, any subscripts
1775 -- in P must have their evaluation forced.
1779 then
1780 declare
1786 begin
1787 -- Insert the post assignment first, because we want to copy the
1788 -- BPAR_Expr tree before it gets analyzed in the context of the
1789 -- pre assignment. Note that we do not analyze the post assignment
1790 -- yet (we cannot till we have completed the analysis of the pre
1791 -- assignment). As usual, the analysis of this post assignment
1792 -- will happen on its own when we "run into" it after finishing
1793 -- the current assignment.
1800 -- At this stage BPAR_Expr is a reference to a bit packed array
1801 -- where the reference was not expanded in the original tree,
1802 -- since it was on the left side of an assignment. But in the
1803 -- pre-assignment statement (the object definition), BPAR_Expr
1804 -- will end up on the right hand side, and must be reexpanded. To
1805 -- achieve this, we reset the analyzed flag of all selected and
1806 -- indexed components down to the actual indexed component for
1807 -- the packed array.
1810 loop
1813 if Nkind_In
1815 then
1817 else
1822 -- Now we can insert and analyze the pre-assignment
1824 -- If the right-hand side requires a transient scope, it has
1825 -- already been placed on the stack. However, the declaration is
1826 -- inserted in the tree outside of this scope, and must reflect
1827 -- the proper scope for its variable. This awkward bit is forced
1828 -- by the stricter scope discipline imposed by GCC 2.97.
1830 declare
1832 Scope_Is_Transient
1835 begin
1847 Pop_Scope;
1851 -- Now fix up the original assignment and continue processing
1856 -- We do not need to reanalyze that assignment, and we do not need
1857 -- to worry about references to the temporary, but we do need to
1858 -- make sure that the temporary is not marked as a true constant
1859 -- since we now have a generated assignment to it.
1865 -- When we have the appropriate type of aggregate in the expression (it
1866 -- has been determined during analysis of the aggregate by setting the
1867 -- delay flag), let's perform in place assignment and thus avoid
1868 -- creating a temporary.
1877 -- Apply discriminant check if required. If Lhs is an access type to a
1878 -- designated type with discriminants, we must always check. If the
1879 -- type has unknown discriminants, more elaborate processing below.
1883 then
1884 -- Skip discriminant check if change of representation. Will be
1885 -- done when the change of representation is expanded out.
1891 -- If the type is private without discriminants, and the full type
1892 -- has discriminants (necessarily with defaults) a check may still be
1893 -- necessary if the Lhs is aliased. The private discriminants must be
1894 -- visible to build the discriminant constraints.
1896 -- Only an explicit dereference that comes from source indicates
1897 -- aliasing. Access to formals of protected operations and entries
1898 -- create dereferences but are not semantic aliasings.
1904 then
1905 declare
1909 begin
1910 -- In the case of an expander-generated record subtype whose base
1911 -- type still appears private, Typ will have been set to that
1912 -- private type rather than the underlying record type (because
1913 -- Underlying type will have returned the record subtype), so it's
1914 -- necessary to apply Underlying_Type again to the base type to
1915 -- get the record type we need for the discriminant check. Such
1916 -- subtypes can be created for assignments in certain cases, such
1917 -- as within an instantiation passed this kind of private type.
1918 -- It would be good to avoid this special test, but making changes
1919 -- to prevent this odd form of record subtype seems difficult. ???
1931 -- If the Lhs has a private type with unknown discriminants, it may
1932 -- have a full view with discriminants, but those are nameable only
1933 -- in the underlying type, so convert the Rhs to it before potential
1934 -- checking. Convert Lhs as well, otherwise the actual subtype might
1935 -- not be constructible.
1939 then
1944 -- In the access type case, we need the same discriminant check, and
1945 -- also range checks if we have an access to constrained array.
1949 then
1952 -- Skip discriminant check if change of representation. Will be
1953 -- done when the change of representation is expanded out.
1967 declare
1971 begin
1972 C_Es :=
1973 Get_Range_Checks
1975 Target_Typ,
1978 Insert_Range_Checks
1980 N,
1981 Target_Typ,
1983 Lhs);
1988 -- Apply range check for access type case
1993 then
1995 Apply_Range_Check
1999 -- Ada 2005 (AI-231): Generate the run-time check
2005 -- If an actual is an out parameter of a null-excluding access
2006 -- type, there is access check on entry, so we set the flag
2007 -- Suppress_Assignment_Checks on the generated statement to
2008 -- assign the actual to the parameter block, and we do not want
2009 -- to generate an additional check at this point.
2012 then
2016 -- Ada 2012 (AI05-148): Update current accessibility level if Rhs is a
2017 -- stand-alone obj of an anonymous access type.
2022 then
2023 declare
2025 -- Look through renames to find the underlying entity.
2026 -- For assignment to a rename, we don't care about the
2027 -- Enclosing_Dynamic_Scope of the rename declaration.
2029 ----------------
2030 -- Lhs_Entity --
2031 ----------------
2036 begin
2039 -- Renamed_Object must return an Entity_Name here
2040 -- because of preceding "Present (E_E_A (...))" test.
2048 -- Local Declarations
2052 Condition =>
2054 Left_Opnd =>
2056 Right_Opnd =>
2058 Intval =>
2059 Scope_Depth
2060 (Enclosing_Dynamic_Scope
2066 Name =>
2067 New_Occurrence_Of
2068 (Effective_Extra_Accessibility
2070 Expression =>
2073 begin
2082 -- Case of assignment to a bit packed array element. If there is a
2083 -- change of representation this must be expanded into components,
2084 -- otherwise this is a bit-field assignment.
2088 then
2089 -- Normal case, no change of representation
2095 -- Change of representation case
2097 else
2098 -- Generate the following, to force component-by-component
2099 -- assignments in an efficient way. Otherwise each component
2100 -- will require a temporary and two bit-field manipulations.
2102 -- T1 : Elmt_Type;
2103 -- T1 := RhS;
2104 -- Lhs := T1;
2106 declare
2110 begin
2111 Stats :=
2112 New_List (
2115 Object_Definition =>
2130 -- Build-in-place function call case. Note that we're not yet doing
2131 -- build-in-place for user-written assignment statements (the assignment
2132 -- here came from an aggregate.)
2136 then
2141 -- Nothing to do for valuetypes
2142 -- ??? Set_Scope_Is_Transient (False);
2148 then
2153 begin
2154 -- In the controlled case, we ensure that function calls are
2155 -- evaluated before finalizing the target. In all cases, it makes
2156 -- the expansion easier if the side-effects are removed first.
2161 -- Avoid recursion in the mechanism
2165 -- If dispatching assignment, we need to dispatch to _assign
2169 -- If the type is tagged, we may as well use the predefined
2170 -- primitive assignment. This avoids inlining a lot of code
2171 -- and in the class-wide case, the assignment is replaced
2172 -- by a dispatching call to _assign. It is suppressed in the
2173 -- case of assignments created by the expander that correspond
2174 -- to initializations, where we do want to copy the tag
2175 -- (Expand_Ctrl_Actions flag is set False in this case). It is
2176 -- also suppressed if restriction No_Dispatching_Calls is in
2177 -- force because in that case predefined primitives are not
2178 -- generated.
2183 and then Expand_Ctrl_Actions
2184 and then
2186 then
2189 -- This can happen in an instance when the formal is an
2190 -- extension of a limited interface, and the actual is
2191 -- limited. This is an error according to AI05-0087, but
2192 -- is not caught at the point of instantiation in earlier
2193 -- versions.
2195 -- This is wrong, error messages cannot be issued during
2196 -- expansion, since they would be missed in -gnatc mode ???
2202 -- Fetch the primitive op _assign and proper type to call it.
2203 -- Because of possible conflicts between private and full view,
2204 -- fetch the proper type directly from the operation profile.
2206 declare
2211 begin
2212 -- If the assignment is dispatching, make sure to use the
2213 -- proper type.
2221 -- In case of assignment to a class-wide tagged type, before
2222 -- the assignment we generate run-time check to ensure that
2223 -- the tags of source and target match.
2229 then
2232 Condition =>
2234 Left_Opnd =>
2237 Selector_Name =>
2239 Right_Opnd =>
2242 Selector_Name =>
2247 declare
2251 begin
2252 -- In order to dispatch the call to _assign the type of
2253 -- the actuals must match. Add conversion (if required).
2272 else
2275 -- We can't afford to have destructive Finalization Actions in
2276 -- the Self assignment case, so if the target and the source
2277 -- are not obviously different, code is generated to avoid the
2278 -- self assignment case:
2280 -- if lhs'address /= rhs'address then
2281 -- <code for controlled and/or tagged assignment>
2282 -- end if;
2284 -- Skip this if Restriction (No_Finalization) is active
2287 and then Expand_Ctrl_Actions
2289 then
2292 Condition =>
2294 Left_Opnd =>
2299 Right_Opnd =>
2307 -- We need to set up an exception handler for implementing
2308 -- 7.6.1(18). The remaining adjustments are tackled by the
2309 -- implementation of adjust for record_controllers (see
2310 -- s-finimp.adb).
2312 -- This is skipped if we have no finalization
2314 if Expand_Ctrl_Actions
2316 then
2319 Handled_Statement_Sequence =>
2329 Handled_Statement_Sequence =>
2332 -- If no restrictions on aborts, protect the whole assignment
2333 -- for controlled objects as per 9.8(11).
2336 and then Expand_Ctrl_Actions
2337 and then Abort_Allowed
2338 then
2339 declare
2341 New_Internal_Entity
2344 begin
2352 Expand_At_End_Handler
2357 -- N has been rewritten to a block statement for which it is
2358 -- known by construction that no checks are necessary: analyze
2359 -- it with all checks suppressed.
2365 -- Array types
2368 declare
2371 begin
2373 N_Qualified_Expression)
2374 loop
2382 -- Record types
2388 -- Scalar types. This is where we perform the processing related to the
2389 -- requirements of (RM 13.9.1(9-11)) concerning the handling of invalid
2390 -- scalar values.
2394 -- Case where right side is known valid
2398 -- Here the right side is valid, so it is fine. The case to deal
2399 -- with is when the left side is a local variable reference whose
2400 -- value is not currently known to be valid. If this is the case,
2401 -- and the assignment appears in an unconditional context, then
2402 -- we can mark the left side as now being valid if one of these
2403 -- conditions holds:
2405 -- The expression of the right side has Do_Range_Check set so
2406 -- that we know a range check will be performed. Note that it
2407 -- can be the case that a range check is omitted because we
2408 -- make the assumption that we can assume validity for operands
2409 -- appearing in the right side in determining whether a range
2410 -- check is required
2412 -- The subtype of the right side matches the subtype of the
2413 -- left side. In this case, even though we have not checked
2414 -- the range of the right side, we know it is in range of its
2415 -- subtype if the expression is valid.
2420 then
2423 then
2428 -- Case where right side may be invalid in the sense of the RM
2429 -- reference above. The RM does not require that we check for the
2430 -- validity on an assignment, but it does require that the assignment
2431 -- of an invalid value not cause erroneous behavior.
2433 -- The general approach in GNAT is to use the Is_Known_Valid flag
2434 -- to avoid the need for validity checking on assignments. However
2435 -- in some cases, we have to do validity checking in order to make
2436 -- sure that the setting of this flag is correct.
2438 else
2439 -- Validate right side if we are validating copies
2441 if Validity_Checks_On
2442 and then Validity_Check_Copies
2443 then
2444 -- Skip this if left hand side is an array or record component
2445 -- and elementary component validity checks are suppressed.
2448 and then not Validity_Check_Components
2449 then
2451 else
2455 -- We can propagate this to the left side where appropriate
2460 then
2464 -- Otherwise check to see what should be done
2466 -- If left side is a local variable, then we just set its flag to
2467 -- indicate that its value may no longer be valid, since we are
2468 -- copying a potentially invalid value.
2473 -- Check for case of a nonlocal variable on the left side which
2474 -- is currently known to be valid. In this case, we simply ensure
2475 -- that the right side is valid. We only play the game of copying
2476 -- validity status for local variables, since we are doing this
2477 -- statically, not by tracing the full flow graph.
2481 then
2482 -- Note: If Validity_Checking mode is set to none, we ignore
2483 -- the Ensure_Valid call so don't worry about that case here.
2487 -- In all other cases, we can safely copy an invalid value without
2488 -- worrying about the status of the left side. Since it is not a
2489 -- variable reference it will not be considered
2490 -- as being known to be valid in any case.
2492 else
2498 exception
2503 ------------------------------
2504 -- Expand_N_Block_Statement --
2505 ------------------------------
2507 -- Encode entity names defined in block statement
2510 begin
2514 -----------------------------
2515 -- Expand_N_Case_Statement --
2516 -----------------------------
2527 begin
2528 -- Check for the situation where we know at compile time which branch
2529 -- will be taken
2534 -- Do not consider controlled objects found in a case statement which
2535 -- actually models a case expression because their early finalization
2536 -- will affect the result of the expression.
2542 -- Move statements from this alternative after the case statement.
2543 -- They are already analyzed, so will be skipped by the analyzer.
2547 -- That leaves the case statement as a shell. So now we can kill all
2548 -- other alternatives in the case statement.
2552 declare
2555 begin
2556 -- Loop through case alternatives, skipping pragmas, and skipping
2557 -- the one alternative that we select (and therefore retain).
2563 then
2575 -- Here if the choice is not determined at compile time
2577 declare
2586 begin
2590 else
2594 -- First step is to worry about possible invalid argument. The RM
2595 -- requires (RM 5.4(13)) that if the result is invalid (e.g. it is
2596 -- outside the base range), then Constraint_Error must be raised.
2598 -- Case of validity check required (validity checks are on, the
2599 -- expression is not known to be valid, and the case statement
2600 -- comes from source -- no need to validity check internally
2601 -- generated case statements).
2607 -- If there is only a single alternative, just replace it with the
2608 -- sequence of statements since obviously that is what is going to
2609 -- be executed in all cases.
2615 -- We still need to evaluate the expression if it has any side
2616 -- effects.
2621 -- Do not consider controlled objects found in a case statement
2622 -- which actually models a case expression because their early
2623 -- finalization will affect the result of the expression.
2631 -- That leaves the case statement as a shell. The alternative that
2632 -- will be executed is reset to a null list. So now we can kill
2633 -- the entire case statement.
2639 -- An optimization. If there are only two alternatives, and only
2640 -- a single choice, then rewrite the whole case statement as an
2641 -- if statement, since this can result in subsequent optimizations.
2642 -- This helps not only with case statements in the source of a
2643 -- simple form, but also with generated code (discriminant check
2644 -- functions in particular).
2646 -- Note: it is OK to do this before expanding out choices for any
2647 -- static predicates, since the if statement processing will handle
2648 -- the static predicate case fine.
2659 -- For TRUE, generate "expression", not expression = true
2663 then
2666 -- For FALSE, generate "expression" and switch then/else
2670 then
2675 -- For a range, generate "expression in range"
2683 then
2684 Cond :=
2689 -- For any other subexpression "expression = value"
2691 else
2692 Cond :=
2698 -- Now rewrite the case as an IF
2710 -- If the last alternative is not an Others choice, replace it with
2711 -- an N_Others_Choice. Note that we do not bother to call Analyze on
2712 -- the modified case statement, since it's only effect would be to
2713 -- compute the contents of the Others_Discrete_Choices which is not
2714 -- needed by the back end anyway.
2716 -- The reason we do this is that the back end always needs some
2717 -- default for a switch, so if we have not supplied one in the
2718 -- processing above for validity checking, then we need to supply
2719 -- one here.
2723 Set_Others_Discrete_Choices
2728 -- Deal with possible declarations of controlled objects, and also
2729 -- with rewriting choice sequences for static predicate references.
2734 -- Do not consider controlled objects found in a case statement
2735 -- which actually models a case expression because their early
2736 -- finalization will affect the result of the expression.
2751 -----------------------------
2752 -- Expand_N_Exit_Statement --
2753 -----------------------------
2755 -- The only processing required is to deal with a possible C/Fortran
2756 -- boolean value used as the condition for the exit statement.
2759 begin
2763 ----------------------------------
2764 -- Expand_Formal_Container_Loop --
2765 ----------------------------------
2778 begin
2779 -- The expansion resembles the one for Ada containers, but the
2780 -- primitives mention the domain of iteration explicitly, and
2781 -- function First applied to the container yields a cursor directly.
2783 -- Cursor : Cursor_type := First (Container);
2784 -- while Has_Element (Cursor, Container) loop
2785 -- <original loop statements>
2786 -- Cursor := Next (Container, Cursor);
2787 -- end loop;
2789 Build_Formal_Container_Iteration
2801 ------------------------------------------
2802 -- Expand_Formal_Container_Element_Loop --
2803 ------------------------------------------
2827 begin
2828 -- For an element iterator, the Element aspect must be present,
2829 -- (this is checked during analysis) and the expansion takes the form:
2831 -- Cursor : Cursor_type := First (Container);
2832 -- Elmt : Element_Type;
2833 -- while Has_Element (Cursor, Container) loop
2834 -- Elmt := Element (Container, Cursor);
2835 -- <original loop statements>
2836 -- Cursor := Next (Container, Cursor);
2837 -- end loop;
2839 Build_Formal_Container_Iteration
2845 -- Declaration for Element.
2847 Elmt_Decl :=
2852 -- The element is only modified in expanded code, so it appears as
2853 -- unassigned to the warning machinery. We must suppress this spurious
2854 -- warning explicitly.
2858 Elmt_Ref :=
2861 Expression =>
2871 -- The loop is rewritten as a block, to hold the element declaration
2873 New_Loop :=
2876 Handled_Statement_Sequence =>
2884 -----------------------------
2885 -- Expand_N_Goto_Statement --
2886 -----------------------------
2888 -- Add poll before goto if polling active
2891 begin
2895 ---------------------------
2896 -- Expand_N_If_Statement --
2897 ---------------------------
2899 -- First we deal with the case of C and Fortran convention boolean values,
2900 -- with zero/non-zero semantics.
2902 -- Second, we deal with the obvious rewriting for the cases where the
2903 -- condition of the IF is known at compile time to be True or False.
2905 -- Third, we remove elsif parts which have non-empty Condition_Actions and
2906 -- rewrite as independent if statements. For example:
2908 -- if x then xs
2909 -- elsif y then ys
2910 -- ...
2911 -- end if;
2913 -- becomes
2914 --
2915 -- if x then xs
2916 -- else
2917 -- <<condition actions of y>>
2918 -- if y then ys
2919 -- ...
2920 -- end if;
2921 -- end if;
2923 -- This rewriting is needed if at least one elsif part has a non-empty
2924 -- Condition_Actions list. We also do the same processing if there is a
2925 -- constant condition in an elsif part (in conjunction with the first
2926 -- processing step mentioned above, for the recursive call made to deal
2927 -- with the created inner if, this deals with properly optimizing the
2928 -- cases of constant elsif conditions).
2938 -- Indicates whether we want warnings when we delete branches of the
2939 -- if statement based on constant condition analysis. We never want
2940 -- these warnings for expander generated code.
2942 begin
2943 -- Do not consider controlled objects found in an if statement which
2944 -- actually models an if expression because their early finalization
2945 -- will affect the result of the expression.
2953 -- The following loop deals with constant conditions for the IF. We
2954 -- need a loop because as we eliminate False conditions, we grab the
2955 -- first elsif condition and use it as the primary condition.
2959 -- If condition is True, we can simply rewrite the if statement now
2960 -- by replacing it by the series of then statements.
2964 -- All the else parts can be killed
2974 -- If condition is False, then we can delete the condition and
2975 -- the Then statements
2977 else
2978 -- We do not delete the condition if constant condition warnings
2979 -- are enabled, since otherwise we end up deleting the desired
2980 -- warning. Of course the backend will get rid of this True/False
2981 -- test anyway, so nothing is lost here.
2989 -- If there are no elsif statements, then we simply replace the
2990 -- entire if statement by the sequence of else statements.
2995 then
2998 else
3006 -- If there are elsif statements, the first of them becomes the
3007 -- if/then section of the rebuilt if statement This is the case
3008 -- where we loop to reprocess this copied condition.
3010 else
3016 -- Hed might have been captured as the condition determining
3017 -- the current value for an entity. Now it is detached from
3018 -- the tree, so a Current_Value pointer in the condition might
3019 -- need to be updated.
3030 -- Loop through elsif parts, dealing with constant conditions and
3031 -- possible condition actions that are present.
3037 -- Do not consider controlled objects found in an if statement
3038 -- which actually models an if expression because their early
3039 -- finalization will affect the result of the expression.
3047 -- If there are condition actions, then rewrite the if statement
3048 -- as indicated above. We also do the same rewrite for a True or
3049 -- False condition. The further processing of this constant
3050 -- condition is then done by the recursive call to expand the
3051 -- newly created if statement
3055 then
3056 -- Note this is not an implicit if statement, since it is part
3057 -- of an explicit if statement in the source (or of an implicit
3058 -- if statement that has already been tested).
3060 New_If :=
3067 -- Elsif parts for new if come from remaining elsif's of parent
3092 -- No special processing for that elsif part, move to next
3094 else
3100 -- Some more optimizations applicable if we still have an IF statement
3106 -- Another optimization, special cases that can be simplified
3108 -- if expression then
3109 -- return true;
3110 -- else
3111 -- return false;
3112 -- end if;
3114 -- can be changed to:
3116 -- return expression;
3118 -- and
3120 -- if expression then
3121 -- return false;
3122 -- else
3123 -- return true;
3124 -- end if;
3126 -- can be changed to:
3128 -- return not (expression);
3130 -- Only do these optimizations if we are at least at -O1 level and
3131 -- do not do them if control flow optimizations are suppressed.
3135 then
3141 then
3142 declare
3146 begin
3148 and then
3150 then
3151 declare
3155 begin
3157 and then
3159 then
3162 then
3171 then
3174 Expression =>
3176 Right_Opnd =>
3189 --------------------------
3190 -- Expand_Iterator_Loop --
3191 --------------------------
3206 begin
3207 -- Processing for arrays
3216 else
3223 -- Processing for containers
3225 -- For an "of" iterator the name is a container expression, which
3226 -- is transformed into a call to the default iterator.
3228 -- For an iterator of the form "in" the name is a function call
3229 -- that delivers an iterator type.
3231 -- In both cases, analysis of the iterator has introduced an object
3232 -- declaration to capture the domain, so that Container is an entity.
3234 -- The for loop is expanded into a while loop which uses a container
3235 -- specific cursor to desgnate each element.
3237 -- Iter : Iterator_Type := Container.Iterate;
3238 -- Cursor : Cursor_type := First (Iter);
3239 -- while Has_Element (Iter) loop
3240 -- declare
3241 -- -- The block is added when Element_Type is controlled
3243 -- Obj : Pack.Element_Type := Element (Cursor);
3244 -- -- for the "of" loop form
3245 -- begin
3246 -- <original loop statements>
3247 -- end;
3249 -- Cursor := Iter.Next (Cursor);
3250 -- end loop;
3252 -- If "reverse" is present, then the initialization of the cursor
3253 -- uses Last and the step becomes Prev. Pack is the name of the
3254 -- scope where the container package is instantiated.
3256 declare
3264 begin
3265 -- The type of the iterator is the return type of the Iterate
3266 -- function used. For the "of" form this is the default iterator
3267 -- for the type, otherwise it is the type of the explicit
3268 -- function used in the iterator specification. The most common
3269 -- case will be an Iterate function in the container package.
3271 -- The primitive operations of the container type may not be
3272 -- use-visible, so we introduce the name of the enclosing package
3273 -- in the declarations below. The Iterator type is declared in a
3274 -- an instance within the container package itself.
3276 -- If the container type is a derived type, the cursor type is
3277 -- found in the package of the parent type.
3281 else
3287 -- The "of" case uses an internally generated cursor whose type
3288 -- is found in the container package. The domain of iteration
3289 -- is expanded into a call to the default Iterator function, but
3290 -- this expansion does not take place in quantified expressions
3291 -- that are analyzed with expansion disabled, and in that case the
3292 -- type of the iterator must be obtained from the aspect.
3295 declare
3297 Entity
3298 (Find_Value_Of_Aspect
3300 Aspect_Default_Iterator));
3305 begin
3308 -- For an container element iterator, the iterator type
3309 -- is obtained from the corresponding aspect, whose return
3310 -- type is descended from the corresponding interface type
3311 -- in some instance of Ada.Iterator_Interfaces. The actuals
3312 -- of that instantiation are Cursor and Has_Element.
3316 -- The iterator type, which is a class_wide type, may itself
3317 -- be derived locally, so the desired instantiation is the
3318 -- scope of the root type of the iterator type.
3322 -- Rewrite domain of iteration as a call to the default
3323 -- iterator for the container type. If the container is
3324 -- a derived type and the aspect is inherited, convert
3325 -- container to parent type. The Cursor type is also
3326 -- inherited from the scope of the parent.
3330 then
3333 else
3334 Container_Arg :=
3336 Subtype_Mark =>
3337 New_Occurrence_Of
3345 Parameter_Associations =>
3349 -- Find cursor type in proper iterator package, which is an
3350 -- instantiation of Iterator_Interfaces.
3361 -- Generate:
3362 -- Id : Element_Type renames Container (Cursor);
3363 -- This assumes that the container type has an indexing
3364 -- operation with Cursor. The check that this operation
3365 -- exists is performed in Check_Container_Indexing.
3367 Decl :=
3370 Subtype_Mark =>
3372 Name =>
3375 Expressions =>
3378 -- The defining identifier in the iterator is user-visible
3379 -- and must be visible in the debugger.
3383 -- If the container does not have a variable indexing aspect,
3384 -- the element is a constant in the loop.
3388 then
3392 -- If the container holds controlled objects, wrap the loop
3393 -- statements and element renaming declaration with a block.
3394 -- This ensures that the result of Element (Cusor) is
3395 -- cleaned up after each iteration of the loop.
3399 -- Generate:
3400 -- declare
3401 -- Id : Element_Type := Element (curosr);
3402 -- begin
3403 -- <original loop statements>
3404 -- end;
3409 Handled_Statement_Sequence =>
3413 -- Elements do not need finalization
3415 else
3420 -- X in Iterate (S) : type of iterator is type of explicitly
3421 -- given Iterate function, and the loop variable is the cursor.
3422 -- It will be assigned in the loop and must be a variable.
3424 else
3431 -- Determine the advancement and initialization steps for the
3432 -- cursor.
3434 -- Analysis of the expanded loop will verify that the container
3435 -- has a reverse iterator.
3441 else
3446 -- For both iterator forms, add a call to the step operation to
3447 -- advance the cursor. Generate:
3449 -- Cursor := Iterator.Next (Cursor);
3451 -- or else
3453 -- Cursor := Next (Cursor);
3455 declare
3458 begin
3459 Rhs :=
3461 Name =>
3474 -- Generate:
3475 -- while Iterator.Has_Element loop
3476 -- <Stats>
3477 -- end loop;
3479 -- Has_Element is the second actual in the iterator package
3481 New_Loop :=
3483 Iteration_Scheme =>
3485 Condition =>
3487 Name =>
3488 New_Occurrence_Of (
3490 Parameter_Associations =>
3496 -- If present, preserve identifier of loop, which can be used in
3497 -- an exit statement in the body.
3503 -- Create the declarations for Iterator and cursor and insert them
3504 -- before the source loop. Given that the domain of iteration is
3505 -- already an entity, the iterator is just a renaming of that
3506 -- entity. Possible optimization ???
3507 -- Generate:
3509 -- I : Iterator_Type renames Container;
3510 -- C : Cursor_Type := Container.[First | Last];
3518 -- Create declaration for cursor
3520 declare
3523 begin
3524 Decl :=
3527 Object_Definition =>
3529 Expression =>
3532 Selector_Name =>
3535 -- The cursor is only modified in expanded code, so it appears
3536 -- as unassigned to the warning machinery. We must suppress
3537 -- this spurious warning explicitly.
3545 -- If the range of iteration is given by a function call that
3546 -- returns a container, the finalization actions have been saved
3547 -- in the Condition_Actions of the iterator. Insert them now at
3548 -- the head of the loop.
3559 -------------------------------------
3560 -- Expand_Iterator_Loop_Over_Array --
3561 -------------------------------------
3576 -- Start of processing for Expand_Iterator_Loop_Over_Array
3578 begin
3579 -- for Element of Array loop
3581 -- This case requires an internally generated cursor to iterate over
3582 -- the array.
3587 -- Generate:
3588 -- Element : Component_Type renames Array (Iterator);
3590 Ind_Comp :=
3598 Subtype_Mark =>
3602 -- Mark the loop variable as needing debug info, so that expansion
3603 -- of the renaming will result in Materialize_Entity getting set via
3604 -- Debug_Renaming_Declaration. (This setting is needed here because
3605 -- the setting in Freeze_Entity comes after the expansion, which is
3606 -- too late. ???)
3610 -- for Index in Array loop
3612 -- This case utilizes the already given iterator name
3614 else
3618 -- Generate:
3620 -- for Iterator in [reverse] Array'Range (Array_Dim) loop
3621 -- Element : Component_Type renames Array (Iterator);
3622 -- <original loop statements>
3623 -- end loop;
3625 Core_Loop :=
3627 Iteration_Scheme =>
3629 Loop_Parameter_Specification =>
3632 Discrete_Subtype_Definition =>
3642 -- Processing for multidimensional array
3648 -- Generate the dimension loops starting from the innermost one
3650 -- for Iterator in [reverse] Array'Range (Array_Dim - Dim) loop
3651 -- <core loop>
3652 -- end loop;
3654 Core_Loop :=
3656 Iteration_Scheme =>
3658 Loop_Parameter_Specification =>
3661 Discrete_Subtype_Definition =>
3671 -- Update the previously created object renaming declaration with
3672 -- the new iterator.
3679 -- If original loop has a source name, preserve it so it can be
3680 -- recognized by an exit statement in the body of the rewritten loop.
3681 -- This only concerns source names: the generated name of an anonymous
3682 -- loop will be create again during the subsequent analysis below.
3686 then
3694 -----------------------------
3695 -- Expand_N_Loop_Statement --
3696 -----------------------------
3698 -- 1. Remove null loop entirely
3699 -- 2. Deal with while condition for C/Fortran boolean
3700 -- 3. Deal with loops with a non-standard enumeration type range
3701 -- 4. Deal with while loops where Condition_Actions is set
3702 -- 5. Deal with loops over predicated subtypes
3703 -- 6. Deal with loops with iterators over arrays and containers
3704 -- 7. Insert polling call if required
3711 begin
3712 -- Delete null loop
3719 -- Deal with condition for C/Fortran Boolean
3725 -- Generate polling call
3731 -- Nothing more to do for plain loop with no iteration scheme
3736 -- Case of for loop (Loop_Parameter_Specification present)
3738 -- Note: we do not have to worry about validity checking of the for loop
3739 -- range bounds here, since they were frozen with constant declarations
3740 -- and it is during that process that the validity checking is done.
3743 declare
3753 begin
3754 -- Deal with loop over predicates
3758 then
3761 -- Handle the case where we have a for loop with the range type
3762 -- being an enumeration type with non-standard representation.
3763 -- In this case we expand:
3765 -- for x in [reverse] a .. b loop
3766 -- ...
3767 -- end loop;
3769 -- to
3771 -- for xP in [reverse] integer
3772 -- range etype'Pos (a) .. etype'Pos (b)
3773 -- loop
3774 -- declare
3775 -- x : constant etype := Pos_To_Rep (xP);
3776 -- begin
3777 -- ...
3778 -- end;
3779 -- end loop;
3783 then
3784 New_Id :=
3788 -- If the type has a contiguous representation, successive
3789 -- values can be generated as offsets from the first literal.
3792 Expr :=
3795 Left_Opnd =>
3799 else
3800 -- Use the constructed array Enum_Pos_To_Rep
3802 Expr :=
3804 Prefix =>
3806 Expressions =>
3810 -- Build declaration for loop identifier
3812 Decls :=
3813 New_List (
3824 Iteration_Scheme =>
3826 Loop_Parameter_Specification =>
3831 Discrete_Subtype_Definition =>
3834 Subtype_Mark =>
3837 Constraint =>
3839 Range_Expression =>
3842 Low_Bound =>
3844 Prefix =>
3850 Relocate_Node
3853 High_Bound =>
3855 Prefix =>
3861 Relocate_Node
3862 (Type_High_Bound
3868 Handled_Statement_Sequence =>
3874 -- The loop parameter's entity must be removed from the loop
3875 -- scope's entity list and rendered invisible, since it will
3876 -- now be located in the new block scope. Any other entities
3877 -- already associated with the loop scope, such as the loop
3878 -- parameter's subtype, will remain there.
3880 -- In an element loop, the loop will contain a declaration for
3881 -- a cursor variable; otherwise the loop id is the first entity
3882 -- in the scope constructed for the loop.
3898 -- Nothing to do with other cases of for loops
3900 else
3905 -- Second case, if we have a while loop with Condition_Actions set, then
3906 -- we change it into a plain loop:
3908 -- while C loop
3909 -- ...
3910 -- end loop;
3912 -- changed to:
3914 -- loop
3915 -- <<condition actions>>
3916 -- exit when not C;
3917 -- ...
3918 -- end loop
3923 then
3924 declare
3927 begin
3928 ES :=
3930 Condition =>
3937 -- This is not an implicit loop, since it is generated in response
3938 -- to the loop statement being processed. If this is itself
3939 -- implicit, the restriction has already been checked. If not,
3940 -- it is an explicit loop.
3951 -- Here to deal with iterator case
3955 then
3958 -- An iterator loop may generate renaming declarations for elements
3959 -- that require debug information. This is the case in particular
3960 -- with element iterators, where debug information must be generated
3961 -- for the temporary that holds the element value. These temporaries
3962 -- are created within a transient block whose local declarations are
3963 -- transferred to the loop, which now has non-trivial local objects.
3967 then
3972 -- When the iteration scheme mentiones attribute 'Loop_Entry, the loop
3973 -- is transformed into a conditional block where the original loop is
3974 -- the sole statement. Inspect the statements of the nested loop for
3975 -- controlled objects.
3986 ----------------------------
3987 -- Expand_Predicated_Loop --
3988 ----------------------------
3990 -- Note: the expander can handle generation of loops over predicated
3991 -- subtypes for both the dynamic and static cases. Depending on what
3992 -- we decide is allowed in Ada 2012 mode and/or extensions allowed
3993 -- mode, the semantic analyzer may disallow one or both forms.
4004 begin
4005 -- Case of iteration over non-static predicate, should not be possible
4006 -- since this is not allowed by the semantics and should have been
4007 -- caught during analysis of the loop statement.
4012 -- If the predicate list is empty, that corresponds to a predicate of
4013 -- False, in which case the loop won't run at all, and we rewrite the
4014 -- entire loop as a null statement.
4020 -- For expansion over a static predicate we generate the following
4022 -- declare
4023 -- J : Ltype := min-val;
4024 -- begin
4025 -- loop
4026 -- body
4027 -- case J is
4028 -- when endpoint => J := startpoint;
4029 -- when endpoint => J := startpoint;
4030 -- ...
4031 -- when max-val => exit;
4032 -- when others => J := Lval'Succ (J);
4033 -- end case;
4034 -- end loop;
4035 -- end;
4037 -- To make this a little clearer, let's take a specific example:
4039 -- type Int is range 1 .. 10;
4040 -- subtype L is Int with
4041 -- predicate => L in 3 | 10 | 5 .. 7;
4042 -- ...
4043 -- for L in StaticP loop
4044 -- Put_Line ("static:" & J'Img);
4045 -- end loop;
4047 -- In this case, the loop is transformed into
4049 -- begin
4050 -- J : L := 3;
4051 -- loop
4052 -- body
4053 -- case J is
4054 -- when 3 => J := 5;
4055 -- when 7 => J := 10;
4056 -- when 10 => exit;
4057 -- when others => J := L'Succ (J);
4058 -- end case;
4059 -- end loop;
4060 -- end;
4062 else
4071 -- Given static expression or static range, returns an identifier
4072 -- whose value is the low bound of the expression value or range.
4075 -- Given static expression or static range, returns an identifier
4076 -- whose value is the high bound of the expression value or range.
4078 ------------
4079 -- Hi_Val --
4080 ------------
4083 begin
4086 else
4092 ------------
4093 -- Lo_Val --
4094 ------------
4097 begin
4100 else
4106 -- Start of processing for Static_Predicate
4108 begin
4109 -- Convert loop identifier to normal variable and reanalyze it so
4110 -- that this conversion works. We have to use the same defining
4111 -- identifier, since there may be references in the loop body.
4116 -- In most loops the loop variable is assigned in various
4117 -- alternatives in the body. However, in the rare case when
4118 -- the range specifies a single element, the loop variable
4119 -- may trigger a spurious warning that is could be constant.
4120 -- This warning might as well be suppressed.
4124 -- Loop to create branches of case statement
4131 else
4132 S :=
4147 -- Add others choice
4149 S :=
4152 Expression =>
4165 -- Construct case statement and append to body statements
4167 Cstm :=
4173 -- Rewrite the loop
4175 D :=
4185 Handled_Statement_Sequence =>
4197 ------------------------------
4198 -- Make_Tag_Ctrl_Assignment --
4199 ------------------------------
4212 and then not Comp_Asn
4215 -- Tags are not saved and restored when VM_Target because VM tags are
4216 -- represented implicitly in objects.
4222 begin
4223 -- Finalize the target of the assignment when controlled
4225 -- We have two exceptions here:
4227 -- 1. If we are in an init proc since it is an initialization more
4228 -- than an assignment.
4230 -- 2. If the left-hand side is a temporary that was not initialized
4231 -- (or the parent part of a temporary since it is the case in
4232 -- extension aggregates). Such a temporary does not come from
4233 -- source. We must examine the original node for the prefix, because
4234 -- it may be a component of an entry formal, in which case it has
4235 -- been rewritten and does not appear to come from source either.
4237 -- Case of init proc
4242 -- The left hand side is an uninitialized temporary object
4247 N_Object_Declaration
4249 then
4252 else
4254 Make_Final_Call
4259 -- Save the Tag in a local variable Tag_Id
4268 Expression =>
4271 Selector_Name =>
4274 -- Otherwise Tag_Id is not used
4276 else
4280 -- Save the Prev and Next fields on .NET/JVM. This is not needed on non
4281 -- VM targets since the fields are not part of the object.
4285 then
4289 -- Generate:
4290 -- Pnn : Root_Controlled_Ptr := Root_Controlled (L).Prev;
4295 Object_Definition =>
4297 Expression =>
4299 Prefix =>
4300 Unchecked_Convert_To
4302 Selector_Name =>
4305 -- Generate:
4306 -- Nnn : Root_Controlled_Ptr := Root_Controlled (L).Next;
4311 Object_Definition =>
4313 Expression =>
4315 Prefix =>
4316 Unchecked_Convert_To
4318 Selector_Name =>
4322 -- If the tagged type has a full rep clause, expand the assignment into
4323 -- component-wise assignments. Mark the node as unanalyzed in order to
4324 -- generate the proper code and propagate this scenario by setting a
4325 -- flag to avoid infinite recursion.
4334 -- Restore the tag
4339 Name =>
4342 Selector_Name =>
4347 -- Restore the Prev and Next fields on .NET/JVM
4351 then
4352 -- Generate:
4353 -- Root_Controlled (L).Prev := Prev_Id;
4357 Name =>
4359 Prefix =>
4360 Unchecked_Convert_To
4362 Selector_Name =>
4366 -- Generate:
4367 -- Root_Controlled (L).Next := Next_Id;
4371 Name =>
4373 Prefix =>
4374 Unchecked_Convert_To
4380 -- Adjust the target after the assignment when controlled (not in the
4381 -- init proc since it is an initialization more than an assignment).
4385 Make_Adjust_Call
4392 exception
4394 -- Could use comment here ???