| blob | fc6141a53ad6283bcb0569e226ed4c869bcec97a |
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 ------------------------------------------------------------------------------
67 procedure Build_Formal_Container_Iteration
74 -- Utility to create declarations and loop statement for both forms
75 -- of formal container iterators.
78 -- Determine if the right hand side of assignment N is a type conversion
79 -- which requires a change of representation. Called only for the array
80 -- and record cases.
83 -- N is an assignment which assigns an array value. This routine process
84 -- the various special cases and checks required for such assignments,
85 -- including change of representation. Rhs is normally simply the right
86 -- hand side of the assignment, except that if the right hand side is a
87 -- type conversion or a qualified expression, then the RHS is the actual
88 -- expression inside any such type conversions or qualifications.
90 function Expand_Assign_Array_Loop
98 -- N is an assignment statement which assigns an array value. This routine
99 -- expands the assignment into a loop (or nested loops for the case of a
100 -- multi-dimensional array) to do the assignment component by component.
101 -- Larray and Rarray are the entities of the actual arrays on the left
102 -- hand and right hand sides. L_Type and R_Type are the types of these
103 -- arrays (which may not be the same, due to either sliding, or to a
104 -- change of representation case). Ndim is the number of dimensions and
105 -- the parameter Rev indicates if the loops run normally (Rev = False),
106 -- or reversed (Rev = True). The value returned is the constructed
107 -- loop statement. Auxiliary declarations are inserted before node N
108 -- using the standard Insert_Actions mechanism.
111 -- N is an assignment of an untagged record value. This routine handles
112 -- the case where the assignment must be made component by component,
113 -- either because the target is not byte aligned, or there is a change
114 -- of representation, or when we have a tagged type with a representation
115 -- clause (this last case is required because holes in the tagged type
116 -- might be filled with components from child types).
119 -- Use the primitives specified in an Iterable aspect to expand a loop
120 -- over a so-called formal container, primarily for SPARK usage.
123 -- Same, for an iterator of the form " For E of C". In this case the
124 -- iterator provides the name of the element, and the cursor is generated
125 -- internally.
128 -- Expand loop over arrays and containers that uses the form "for X of C"
129 -- with an optional subtype mark, or "for Y in C".
132 -- Expand loop over arrays that uses the form "for X of C"
135 -- Expand for loop over predicated subtype
138 -- Generate the necessary code for controlled and tagged assignment, that
139 -- is to say, finalization of the target before, adjustment of the target
140 -- after and save and restore of the tag and finalization pointers which
141 -- are not 'part of the value' and must not be changed upon assignment. N
142 -- is the original Assignment node.
144 --------------------------------------
145 -- Build_Formal_Container_iteration --
146 --------------------------------------
148 procedure Build_Formal_Container_Iteration
155 is
166 begin
167 -- Declaration for Cursor
169 Init :=
173 Expression =>
179 -- Statement that advances cursor in loop
181 Advance :=
184 Expression =>
191 -- Iterator is rewritten as a while_loop
193 New_Loop :=
195 Iteration_Scheme =>
197 Condition =>
207 ------------------------------
208 -- Change_Of_Representation --
209 ------------------------------
213 begin
214 return
216 and then
220 -------------------------
221 -- Expand_Assign_Array --
222 -------------------------
224 -- There are two issues here. First, do we let Gigi do a block move, or
225 -- do we expand out into a loop? Second, we need to set the two flags
226 -- Forwards_OK and Backwards_OK which show whether the block move (or
227 -- corresponding loops) can be legitimately done in a forwards (low to
228 -- high) or backwards (high to low) manner.
254 -- This switch is set to True if the array move must be done using
255 -- an explicit front end generated loop.
258 -- If the argument is an access to an array, and the assignment is
259 -- converted into a procedure call, apply explicit dereference.
262 -- Test if Exp is a reference to an array whose declaration has
263 -- an address clause, or it is a slice of such an array.
266 -- Test if Exp is a reference to an array which is either a formal
267 -- parameter or a slice of a formal parameter. These are the cases
268 -- where hidden aliasing can occur.
271 -- Determine if Exp is a reference to an array variable which is other
272 -- than an object defined in the current scope, or a slice of such
273 -- an object. Such objects can be aliased to parameters (unlike local
274 -- array references).
276 -----------------------
277 -- Apply_Dereference --
278 -----------------------
282 begin
290 ------------------------
291 -- Has_Address_Clause --
292 ------------------------
295 begin
296 return
299 or else
303 ---------------------
304 -- Is_Formal_Array --
305 ---------------------
308 begin
309 return
311 or else
315 ------------------------
316 -- Is_Non_Local_Array --
317 ------------------------
320 begin
327 -- Determine if Lhs, Rhs are formal arrays or nonlocal arrays
335 -- Start of processing for Expand_Assign_Array
337 begin
338 -- Deal with length check. Note that the length check is done with
339 -- respect to the right hand side as given, not a possible underlying
340 -- renamed object, since this would generate incorrect extra checks.
344 -- We start by assuming that the move can be done in either direction,
345 -- i.e. that the two sides are completely disjoint.
350 -- Normally it is only the slice case that can lead to overlap, and
351 -- explicit checks for slices are made below. But there is one case
352 -- where the slice can be implicit and invisible to us: when we have a
353 -- one dimensional array, and either both operands are parameters, or
354 -- one is a parameter (which can be a slice passed by reference) and the
355 -- other is a non-local variable. In this case the parameter could be a
356 -- slice that overlaps with the other operand.
358 -- However, if the array subtype is a constrained first subtype in the
359 -- parameter case, then we don't have to worry about overlap, since
360 -- slice assignments aren't possible (other than for a slice denoting
361 -- the whole array).
363 -- Note: No overlap is possible if there is a change of representation,
364 -- so we can exclude this case.
367 and then not Crep
368 and then
370 or else
372 or else
374 and then
378 -- In the case of compiling for the Java or .NET Virtual Machine,
379 -- slices are always passed by making a copy, so we don't have to
380 -- worry about overlap. We also want to prevent generation of "<"
381 -- comparisons for array addresses, since that's a meaningless
382 -- operation on the VM.
385 then
389 -- Note: the bit-packed case is not worrisome here, since if we have
390 -- a slice passed as a parameter, it is always aligned on a byte
391 -- boundary, and if there are no explicit slices, the assignment
392 -- can be performed directly.
395 -- If either operand has an address clause clear Backwards_OK and
396 -- Forwards_OK, since we cannot tell if the operands overlap. We
397 -- exclude this treatment when Rhs is an aggregate, since we know
398 -- that overlap can't occur.
402 then
407 -- We certainly must use a loop for change of representation and also
408 -- we use the operand of the conversion on the right hand side as the
409 -- effective right hand side (the component types must match in this
410 -- situation).
417 -- We require a loop if the left side is possibly bit unaligned
420 or else
422 then
425 -- Arrays with controlled components are expanded into a loop to force
426 -- calls to Adjust at the component level.
431 -- If object is atomic, we cannot tolerate a loop
434 or else
436 then
439 -- Loop is required if we have atomic components since we have to
440 -- be sure to do any accesses on an element by element basis.
446 then
449 -- Case where no slice is involved
453 -- The following code deals with the case of unconstrained bit packed
454 -- arrays. The problem is that the template for such arrays contains
455 -- the bounds of the actual source level array, but the copy of an
456 -- entire array requires the bounds of the underlying array. It would
457 -- be nice if the back end could take care of this, but right now it
458 -- does not know how, so if we have such a type, then we expand out
459 -- into a loop, which is inefficient but works correctly. If we don't
460 -- do this, we get the wrong length computed for the array to be
461 -- moved. The two cases we need to worry about are:
463 -- Explicit dereference of an unconstrained packed array type as in
464 -- the following example:
466 -- procedure C52 is
467 -- type BITS is array(INTEGER range <>) of BOOLEAN;
468 -- pragma PACK(BITS);
469 -- type A is access BITS;
470 -- P1,P2 : A;
471 -- begin
472 -- P1 := new BITS (1 .. 65_535);
473 -- P2 := new BITS (1 .. 65_535);
474 -- P2.ALL := P1.ALL;
475 -- end C52;
477 -- A formal parameter reference with an unconstrained bit array type
478 -- is the other case we need to worry about (here we assume the same
479 -- BITS type declared above):
481 -- procedure Write_All (File : out BITS; Contents : BITS);
482 -- begin
483 -- File.Storage := Contents;
484 -- end Write_All;
486 -- We expand to a loop in either of these two cases
488 -- Question for future thought. Another potentially more efficient
489 -- approach would be to create the actual subtype, and then do an
490 -- unchecked conversion to this actual subtype ???
495 -- Function to perform required test for the first case, above
496 -- (dereference of an unconstrained bit packed array).
498 -----------------------
499 -- Is_UBPA_Reference --
500 -----------------------
507 begin
511 then
520 else
522 return
527 else
532 -- Start of processing for Check_Unconstrained_Bit_Packed_Array
534 begin
536 or else
538 then
541 -- Here if we do not have the case of a reference to a bit packed
542 -- unconstrained array case. In this case gigi can most certainly
543 -- handle the assignment if a forwards move is allowed.
545 -- (could it handle the backwards case also???)
552 -- The back end can always handle the assignment if the right side is a
553 -- string literal (note that overlap is definitely impossible in this
554 -- case). If the type is packed, a string literal is always converted
555 -- into an aggregate, except in the case of a null slice, for which no
556 -- aggregate can be written. In that case, rewrite the assignment as a
557 -- null statement, a length check has already been emitted to verify
558 -- that the range of the left-hand side is empty.
560 -- Note that this code is not executed if we have an assignment of a
561 -- string literal to a non-bit aligned component of a record, a case
562 -- which cannot be handled by the backend.
567 then
574 -- If either operand is bit packed, then we need a loop, since we can't
575 -- be sure that the slice is byte aligned. Similarly, if either operand
576 -- is a possibly unaligned slice, then we need a loop (since the back
577 -- end cannot handle unaligned slices).
583 then
586 -- If we are not bit-packed, and we have only one slice, then no overlap
587 -- is possible except in the parameter case, so we can let the back end
588 -- handle things.
596 -- If the right-hand side is a string literal, introduce a temporary for
597 -- it, for use in the generated loop that will follow.
600 declare
604 begin
605 Decl :=
617 -- Come here to complete the analysis
619 -- Loop_Required: Set to True if we know that a loop is required
620 -- regardless of overlap considerations.
622 -- Forwards_OK: Set to False if we already know that a forwards
623 -- move is not safe, else set to True.
625 -- Backwards_OK: Set to False if we already know that a backwards
626 -- move is not safe, else set to True
628 -- Our task at this stage is to complete the overlap analysis, which can
629 -- result in possibly setting Forwards_OK or Backwards_OK to False, and
630 -- then generating the final code, either by deciding that it is OK
631 -- after all to let Gigi handle it, or by generating appropriate code
632 -- in the front end.
634 declare
652 begin
653 -- Get the expressions for the arrays. If we are dealing with a
654 -- private type, then convert to the underlying type. We can do
655 -- direct assignments to an array that is a private type, but we
656 -- cannot assign to elements of the array without this extra
657 -- unchecked conversion.
659 -- Note: We propagate Parent to the conversion nodes to generate
660 -- a well-formed subtree.
664 else
668 declare
670 begin
671 Larray :=
672 Unchecked_Convert_To
681 else
685 declare
687 begin
688 Rarray :=
689 Unchecked_Convert_To
696 -- If both sides are slices, we must figure out whether it is safe
697 -- to do the move in one direction or the other. It is always safe
698 -- if there is a change of representation since obviously two arrays
699 -- with different representations cannot possibly overlap.
705 -- If both left and right hand arrays are entity names, and refer
706 -- to different entities, then we know that the move is safe (the
707 -- two storage areas are completely disjoint).
712 then
715 -- Otherwise, we assume the worst, which is that the two arrays
716 -- are the same array. There is no need to check if we know that
717 -- is the case, because if we don't know it, we still have to
718 -- assume it.
720 -- Generally if the same array is involved, then we have an
721 -- overlapping case. We will have to really assume the worst (i.e.
722 -- set neither of the OK flags) unless we can determine the lower
723 -- or upper bounds at compile time and compare them.
725 else
726 Cresult :=
727 Compile_Time_Compare
731 Cresult :=
732 Compile_Time_Compare
745 -- If after that analysis Loop_Required is False, meaning that we
746 -- have not discovered some non-overlap reason for requiring a loop,
747 -- then the outcome depends on the capabilities of the back end.
751 -- The GCC back end can deal with all cases of overlap by falling
752 -- back to memmove if it cannot use a more efficient approach.
757 -- Assume other back ends can handle it if Forwards_OK is set
762 -- If Forwards_OK is not set, the back end will need something
763 -- like memmove to handle the move. For now, this processing is
764 -- activated using the .s debug flag (-gnatd.s).
771 -- At this stage we have to generate an explicit loop, and we have
772 -- the following cases:
774 -- Forwards_OK = True
776 -- Rnn : right_index := right_index'First;
777 -- for Lnn in left-index loop
778 -- left (Lnn) := right (Rnn);
779 -- Rnn := right_index'Succ (Rnn);
780 -- end loop;
782 -- Note: the above code MUST be analyzed with checks off, because
783 -- otherwise the Succ could overflow. But in any case this is more
784 -- efficient.
786 -- Forwards_OK = False, Backwards_OK = True
788 -- Rnn : right_index := right_index'Last;
789 -- for Lnn in reverse left-index loop
790 -- left (Lnn) := right (Rnn);
791 -- Rnn := right_index'Pred (Rnn);
792 -- end loop;
794 -- Note: the above code MUST be analyzed with checks off, because
795 -- otherwise the Pred could overflow. But in any case this is more
796 -- efficient.
798 -- Forwards_OK = Backwards_OK = False
800 -- This only happens if we have the same array on each side. It is
801 -- possible to create situations using overlays that violate this,
802 -- but we simply do not promise to get this "right" in this case.
804 -- There are two possible subcases. If the No_Implicit_Conditionals
805 -- restriction is set, then we generate the following code:
807 -- declare
808 -- T : constant <operand-type> := rhs;
809 -- begin
810 -- lhs := T;
811 -- end;
813 -- If implicit conditionals are permitted, then we generate:
815 -- if Left_Lo <= Right_Lo then
816 -- <code for Forwards_OK = True above>
817 -- else
818 -- <code for Backwards_OK = True above>
819 -- end if;
821 -- In order to detect possible aliasing, we examine the renamed
822 -- expression when the source or target is a renaming. However,
823 -- the renaming may be intended to capture an address that may be
824 -- affected by subsequent code, and therefore we must recover
825 -- the actual entity for the expansion that follows, not the
826 -- object it renames. In particular, if source or target designate
827 -- a portion of a dynamically allocated object, the pointer to it
828 -- may be reassigned but the renaming preserves the proper location.
831 and then
834 then
839 and then
842 then
846 -- Cases where either Forwards_OK or Backwards_OK is true
853 then
854 declare
859 begin
871 New_Occurrence_Of (
880 else
882 Expand_Assign_Array_Loop
887 -- Case of both are false with No_Implicit_Conditionals
890 declare
894 begin
901 Object_Definition =>
905 Handled_Statement_Sequence =>
913 -- Case of both are false with implicit conditionals allowed
915 else
916 -- Before we generate this code, we must ensure that the left and
917 -- right side array types are defined. They may be itypes, and we
918 -- cannot let them be defined inside the if, since the first use
919 -- in the then may not be executed.
924 -- We normally compare addresses to find out which way round to
925 -- do the loop, since this is reliable, and handles the cases of
926 -- parameters, conversions etc. But we can't do that in the bit
927 -- packed case or the VM case, because addresses don't work there.
930 Condition :=
932 Left_Opnd =>
935 Prefix =>
937 Prefix =>
941 Prefix =>
942 New_Occurrence_Of
947 Right_Opnd =>
950 Prefix =>
952 Prefix =>
956 Prefix =>
957 New_Occurrence_Of
962 -- For the bit packed and VM cases we use the bounds. That's OK,
963 -- because we don't have to worry about parameters, since they
964 -- cannot cause overlap. Perhaps we should worry about weird slice
965 -- conversions ???
967 else
968 -- Copy the bounds
973 -- If the types do not match we add an implicit conversion
974 -- here to ensure proper match
977 Cright_Lo :=
981 -- Reset the Analyzed flag, because the bounds of the index
982 -- type itself may be universal, and must must be reanalyzed
983 -- to acquire the proper type for the back end.
988 Condition :=
998 then
1000 -- Call TSS procedure for array assignment, passing the
1001 -- explicit bounds of right and left hand sides.
1003 declare
1008 begin
1029 else
1035 Expand_Assign_Array_Loop
1040 Expand_Assign_Array_Loop
1049 exception
1054 ------------------------------
1055 -- Expand_Assign_Array_Loop --
1056 ------------------------------
1058 -- The following is an example of the loop generated for the case of a
1059 -- two-dimensional array:
1061 -- declare
1062 -- R2b : Tm1X1 := 1;
1063 -- begin
1064 -- for L1b in 1 .. 100 loop
1065 -- declare
1066 -- R4b : Tm1X2 := 1;
1067 -- begin
1068 -- for L3b in 1 .. 100 loop
1069 -- vm1 (L1b, L3b) := vm2 (R2b, R4b);
1070 -- R4b := Tm1X2'succ(R4b);
1071 -- end loop;
1072 -- end;
1073 -- R2b := Tm1X1'succ(R2b);
1074 -- end loop;
1075 -- end;
1077 -- Here Rev is False, and Tm1Xn are the subscript types for the right hand
1078 -- side. The declarations of R2b and R4b are inserted before the original
1079 -- assignment statement.
1081 function Expand_Assign_Array_Loop
1089 is
1094 -- Entities used as subscripts on left and right sides
1098 -- Left and right index types
1106 -- The increment step for the index of the right-hand side is written
1107 -- as an attribute reference (Succ or Pred). This function returns
1108 -- the corresponding node, which is placed at the end of the loop body.
1110 ----------------
1111 -- Build_Step --
1112 ----------------
1118 begin
1121 else
1125 Step :=
1128 Expression =>
1130 Prefix =>
1136 -- Note that on the last iteration of the loop, the index is increased
1137 -- (or decreased) past the corresponding bound. This is consistent with
1138 -- the C semantics of the back-end, where such an off-by-one value on a
1139 -- dead index variable is OK. However, in CodePeer mode this leads to
1140 -- spurious warnings, and thus we place a guard around the attribute
1141 -- reference. For obvious reasons we only do this for CodePeer.
1144 Step :=
1146 Condition =>
1149 Right_Opnd =>
1159 -- Start of processing for Expand_Assign_Array_Loop
1161 begin
1165 else
1170 -- Setup index types and subscript entities
1172 declare
1176 begin
1192 -- Now construct the assignment statement
1194 declare
1198 begin
1204 Assign :=
1206 Name =>
1210 Expression =>
1215 -- We set assignment OK, since there are some cases, e.g. in object
1216 -- declarations, where we are actually assigning into a constant.
1217 -- If there really is an illegality, it was caught long before now,
1218 -- and was flagged when the original assignment was analyzed.
1222 -- Propagate the No_Ctrl_Actions flag to individual assignments
1227 -- Now construct the loop from the inside out, with the last subscript
1228 -- varying most rapidly. Note that Assign is first the raw assignment
1229 -- statement, and then subsequently the loop that wraps it up.
1232 Assign :=
1237 Object_Definition =>
1239 Expression =>
1244 Handled_Statement_Sequence =>
1248 Iteration_Scheme =>
1250 Loop_Parameter_Specification =>
1254 Discrete_Subtype_Definition =>
1263 --------------------------
1264 -- Expand_Assign_Record --
1265 --------------------------
1272 begin
1273 -- If change of representation, then extract the real right hand side
1274 -- from the type conversion, and proceed with component-wise assignment,
1275 -- since the two types are not the same as far as the back end is
1276 -- concerned.
1281 -- If this may be a case of a large bit aligned component, then proceed
1282 -- with component-wise assignment, to avoid possible clobbering of other
1283 -- components sharing bits in the first or last byte of the component to
1284 -- be assigned.
1287 or
1289 then
1292 -- If we have a tagged type that has a complete record representation
1293 -- clause, we must do we must do component-wise assignments, since child
1294 -- types may have used gaps for their components, and we might be
1295 -- dealing with a view conversion.
1300 -- If neither condition met, then nothing special to do, the back end
1301 -- can handle assignment of the entire component as a single entity.
1303 else
1307 -- At this stage we know that we must do a component wise assignment
1309 declare
1316 function Find_Component
1319 -- Find the component with the given name in the underlying record
1320 -- declaration for Typ. We need to use the actual entity because the
1321 -- type may be private and resolution by identifier alone would fail.
1323 function Make_Component_List_Assign
1326 -- Returns a sequence of statements to assign the components that
1327 -- are referenced in the given component list. The flag U_U is
1328 -- used to force the usage of the inferred value of the variant
1329 -- part expression as the switch for the generated case statement.
1331 function Make_Field_Assign
1334 -- Given C, the entity for a discriminant or component, build an
1335 -- assignment for the corresponding field values. The flag U_U
1336 -- signals the presence of an Unchecked_Union and forces the usage
1337 -- of the inferred discriminant value of C as the right hand side
1338 -- of the assignment.
1341 -- Given CI, a component items list, construct series of statements
1342 -- for fieldwise assignment of the corresponding components.
1344 --------------------
1345 -- Find_Component --
1346 --------------------
1348 function Find_Component
1351 is
1355 begin
1368 --------------------------------
1369 -- Make_Component_List_Assign --
1370 --------------------------------
1372 function Make_Component_List_Assign
1375 is
1386 begin
1403 Statements =>
1408 -- If we have an Unchecked_Union, use the value of the inferred
1409 -- discriminant of the variant part expression as the switch
1410 -- for the case statement. The case statement may later be
1411 -- folded.
1414 Expr :=
1419 else
1420 Expr :=
1423 Selector_Name =>
1436 -----------------------
1437 -- Make_Field_Assign --
1438 -----------------------
1440 function Make_Field_Assign
1443 is
1447 begin
1448 -- In the case of an Unchecked_Union, use the discriminant
1449 -- constraint value as on the right hand side of the assignment.
1452 Expr :=
1456 else
1457 Expr :=
1463 A :=
1465 Name =>
1468 Selector_Name =>
1472 -- Set Assignment_OK, so discriminants can be assigned
1479 then
1486 ------------------------
1487 -- Make_Field_Assigns --
1488 ------------------------
1494 begin
1500 -- Look for components, but exclude _tag field assignment if
1501 -- the special Componentwise_Assignment flag is set.
1506 then
1507 Append_To
1517 -- Start of processing for Expand_Assign_Record
1519 begin
1520 -- Note that we use the base types for this processing. This results
1521 -- in some extra work in the constrained case, but the change of
1522 -- representation case is so unusual that it is not worth the effort.
1524 -- First copy the discriminants. This is done unconditionally. It
1525 -- is required in the unconstrained left side case, and also in the
1526 -- case where this assignment was constructed during the expansion
1527 -- of a type conversion (since initialization of discriminants is
1528 -- suppressed in this case). It is unnecessary but harmless in
1529 -- other cases.
1535 -- If we are expanding the initialization of a derived record
1536 -- that constrains or renames discriminants of the parent, we
1537 -- must use the corresponding discriminant in the parent.
1539 declare
1542 begin
1543 if Inside_Init_Proc
1545 then
1547 else
1553 -- Within an initialization procedure this is the
1554 -- assignment to an unchecked union component, in which
1555 -- case there is no discriminant to initialize.
1560 else
1561 -- The assignment is part of a conversion from a
1562 -- derived unchecked union type with an inferable
1563 -- discriminant, to a parent type.
1568 else
1577 -- We know the underlying type is a record, but its current view
1578 -- may be private. We must retrieve the usable record declaration.
1581 N_Private_Extension_Declaration)
1583 then
1585 else
1595 then
1599 else
1600 Insert_Actions
1609 -----------------------------------
1610 -- Expand_N_Assignment_Statement --
1611 -----------------------------------
1613 -- This procedure implements various cases where an assignment statement
1614 -- cannot just be passed on to the back end in untransformed state.
1624 begin
1625 -- Special case to check right away, if the Componentwise_Assignment
1626 -- flag is set, this is a reanalysis from the expansion of the primitive
1627 -- assignment procedure for a tagged type, and all we need to do is to
1628 -- expand to assignment of components, because otherwise, we would get
1629 -- infinite recursion (since this looks like a tagged assignment which
1630 -- would normally try to *call* the primitive assignment procedure).
1637 -- Defend against invalid subscripts on left side if we are in standard
1638 -- validity checking mode. No need to do this if we are checking all
1639 -- subscripts.
1641 -- Note that we do this right away, because there are some early return
1642 -- paths in this procedure, and this is required on all paths.
1644 if Validity_Checks_On
1645 and then Validity_Check_Default
1646 and then not Validity_Check_Subscripts
1647 then
1651 -- Ada 2005 (AI-327): Handle assignment to priority of protected object
1653 -- Rewrite an assignment to X'Priority into a run-time call
1655 -- For example: X'Priority := New_Prio_Expr;
1656 -- ...is expanded into Set_Ceiling (X._Object, New_Prio_Expr);
1658 -- Note that although X'Priority is notionally an object, it is quite
1659 -- deliberately not defined as an aliased object in the RM. This means
1660 -- that it works fine to rewrite it as a call, without having to worry
1661 -- about complications that would other arise from X'Priority'Access,
1662 -- which is illegal, because of the lack of aliasing.
1665 declare
1672 begin
1673 -- Handle chains of renamings
1679 loop
1683 -- The attribute Priority applied to protected objects has been
1684 -- previously expanded into a call to the Get_Ceiling run-time
1685 -- subprogram.
1689 or else
1691 then
1692 -- Look for the enclosing concurrent type
1701 -- Generate the first actual of the call
1708 -- Select the appropriate run-time call
1711 RT_Subprg_Name :=
1713 else
1714 RT_Subprg_Name :=
1718 Call :=
1732 -- Deal with assignment checks unless suppressed
1736 -- First deal with generation of range check if required
1742 -- Then generate predicate check if required
1747 -- Check for a special case where a high level transformation is
1748 -- required. If we have either of:
1750 -- P.field := rhs;
1751 -- P (sub) := rhs;
1753 -- where P is a reference to a bit packed array, then we have to unwind
1754 -- the assignment. The exact meaning of being a reference to a bit
1755 -- packed array is as follows:
1757 -- An indexed component whose prefix is a bit packed array is a
1758 -- reference to a bit packed array.
1760 -- An indexed component or selected component whose prefix is a
1761 -- reference to a bit packed array is itself a reference ot a
1762 -- bit packed array.
1764 -- The required transformation is
1766 -- Tnn : prefix_type := P;
1767 -- Tnn.field := rhs;
1768 -- P := Tnn;
1770 -- or
1772 -- Tnn : prefix_type := P;
1773 -- Tnn (subscr) := rhs;
1774 -- P := Tnn;
1776 -- Since P is going to be evaluated more than once, any subscripts
1777 -- in P must have their evaluation forced.
1781 then
1782 declare
1788 begin
1789 -- Insert the post assignment first, because we want to copy the
1790 -- BPAR_Expr tree before it gets analyzed in the context of the
1791 -- pre assignment. Note that we do not analyze the post assignment
1792 -- yet (we cannot till we have completed the analysis of the pre
1793 -- assignment). As usual, the analysis of this post assignment
1794 -- will happen on its own when we "run into" it after finishing
1795 -- the current assignment.
1802 -- At this stage BPAR_Expr is a reference to a bit packed array
1803 -- where the reference was not expanded in the original tree,
1804 -- since it was on the left side of an assignment. But in the
1805 -- pre-assignment statement (the object definition), BPAR_Expr
1806 -- will end up on the right hand side, and must be reexpanded. To
1807 -- achieve this, we reset the analyzed flag of all selected and
1808 -- indexed components down to the actual indexed component for
1809 -- the packed array.
1812 loop
1815 if Nkind_In
1817 then
1819 else
1824 -- Now we can insert and analyze the pre-assignment
1826 -- If the right-hand side requires a transient scope, it has
1827 -- already been placed on the stack. However, the declaration is
1828 -- inserted in the tree outside of this scope, and must reflect
1829 -- the proper scope for its variable. This awkward bit is forced
1830 -- by the stricter scope discipline imposed by GCC 2.97.
1832 declare
1834 Scope_Is_Transient
1837 begin
1849 Pop_Scope;
1853 -- Now fix up the original assignment and continue processing
1858 -- We do not need to reanalyze that assignment, and we do not need
1859 -- to worry about references to the temporary, but we do need to
1860 -- make sure that the temporary is not marked as a true constant
1861 -- since we now have a generated assignment to it.
1867 -- When we have the appropriate type of aggregate in the expression (it
1868 -- has been determined during analysis of the aggregate by setting the
1869 -- delay flag), let's perform in place assignment and thus avoid
1870 -- creating a temporary.
1879 -- Apply discriminant check if required. If Lhs is an access type to a
1880 -- designated type with discriminants, we must always check. If the
1881 -- type has unknown discriminants, more elaborate processing below.
1885 then
1886 -- Skip discriminant check if change of representation. Will be
1887 -- done when the change of representation is expanded out.
1893 -- If the type is private without discriminants, and the full type
1894 -- has discriminants (necessarily with defaults) a check may still be
1895 -- necessary if the Lhs is aliased. The private discriminants must be
1896 -- visible to build the discriminant constraints.
1898 -- Only an explicit dereference that comes from source indicates
1899 -- aliasing. Access to formals of protected operations and entries
1900 -- create dereferences but are not semantic aliasings.
1906 then
1907 declare
1911 begin
1912 -- In the case of an expander-generated record subtype whose base
1913 -- type still appears private, Typ will have been set to that
1914 -- private type rather than the underlying record type (because
1915 -- Underlying type will have returned the record subtype), so it's
1916 -- necessary to apply Underlying_Type again to the base type to
1917 -- get the record type we need for the discriminant check. Such
1918 -- subtypes can be created for assignments in certain cases, such
1919 -- as within an instantiation passed this kind of private type.
1920 -- It would be good to avoid this special test, but making changes
1921 -- to prevent this odd form of record subtype seems difficult. ???
1933 -- If the Lhs has a private type with unknown discriminants, it may
1934 -- have a full view with discriminants, but those are nameable only
1935 -- in the underlying type, so convert the Rhs to it before potential
1936 -- checking. Convert Lhs as well, otherwise the actual subtype might
1937 -- not be constructible.
1941 then
1946 -- In the access type case, we need the same discriminant check, and
1947 -- also range checks if we have an access to constrained array.
1951 then
1954 -- Skip discriminant check if change of representation. Will be
1955 -- done when the change of representation is expanded out.
1969 declare
1973 begin
1974 C_Es :=
1975 Get_Range_Checks
1977 Target_Typ,
1980 Insert_Range_Checks
1982 N,
1983 Target_Typ,
1985 Lhs);
1990 -- Apply range check for access type case
1995 then
1997 Apply_Range_Check
2001 -- Ada 2005 (AI-231): Generate the run-time check
2007 -- If an actual is an out parameter of a null-excluding access
2008 -- type, there is access check on entry, so we set the flag
2009 -- Suppress_Assignment_Checks on the generated statement to
2010 -- assign the actual to the parameter block, and we do not want
2011 -- to generate an additional check at this point.
2014 then
2018 -- Ada 2012 (AI05-148): Update current accessibility level if Rhs is a
2019 -- stand-alone obj of an anonymous access type.
2024 then
2025 declare
2027 -- Look through renames to find the underlying entity.
2028 -- For assignment to a rename, we don't care about the
2029 -- Enclosing_Dynamic_Scope of the rename declaration.
2031 ----------------
2032 -- Lhs_Entity --
2033 ----------------
2038 begin
2041 -- Renamed_Object must return an Entity_Name here
2042 -- because of preceding "Present (E_E_A (...))" test.
2050 -- Local Declarations
2054 Condition =>
2056 Left_Opnd =>
2058 Right_Opnd =>
2060 Intval =>
2061 Scope_Depth
2062 (Enclosing_Dynamic_Scope
2068 Name =>
2069 New_Occurrence_Of
2070 (Effective_Extra_Accessibility
2072 Expression =>
2075 begin
2084 -- Case of assignment to a bit packed array element. If there is a
2085 -- change of representation this must be expanded into components,
2086 -- otherwise this is a bit-field assignment.
2090 then
2091 -- Normal case, no change of representation
2097 -- Change of representation case
2099 else
2100 -- Generate the following, to force component-by-component
2101 -- assignments in an efficient way. Otherwise each component
2102 -- will require a temporary and two bit-field manipulations.
2104 -- T1 : Elmt_Type;
2105 -- T1 := RhS;
2106 -- Lhs := T1;
2108 declare
2112 begin
2113 Stats :=
2114 New_List (
2117 Object_Definition =>
2132 -- Build-in-place function call case. Note that we're not yet doing
2133 -- build-in-place for user-written assignment statements (the assignment
2134 -- here came from an aggregate.)
2138 then
2143 -- Nothing to do for valuetypes
2144 -- ??? Set_Scope_Is_Transient (False);
2150 then
2155 begin
2156 -- In the controlled case, we ensure that function calls are
2157 -- evaluated before finalizing the target. In all cases, it makes
2158 -- the expansion easier if the side-effects are removed first.
2163 -- Avoid recursion in the mechanism
2167 -- If dispatching assignment, we need to dispatch to _assign
2171 -- If the type is tagged, we may as well use the predefined
2172 -- primitive assignment. This avoids inlining a lot of code
2173 -- and in the class-wide case, the assignment is replaced
2174 -- by a dispatching call to _assign. It is suppressed in the
2175 -- case of assignments created by the expander that correspond
2176 -- to initializations, where we do want to copy the tag
2177 -- (Expand_Ctrl_Actions flag is set False in this case). It is
2178 -- also suppressed if restriction No_Dispatching_Calls is in
2179 -- force because in that case predefined primitives are not
2180 -- generated.
2185 and then Expand_Ctrl_Actions
2186 and then
2188 then
2191 -- This can happen in an instance when the formal is an
2192 -- extension of a limited interface, and the actual is
2193 -- limited. This is an error according to AI05-0087, but
2194 -- is not caught at the point of instantiation in earlier
2195 -- versions.
2197 -- This is wrong, error messages cannot be issued during
2198 -- expansion, since they would be missed in -gnatc mode ???
2204 -- Fetch the primitive op _assign and proper type to call it.
2205 -- Because of possible conflicts between private and full view,
2206 -- fetch the proper type directly from the operation profile.
2208 declare
2213 begin
2214 -- If the assignment is dispatching, make sure to use the
2215 -- proper type.
2223 -- In case of assignment to a class-wide tagged type, before
2224 -- the assignment we generate run-time check to ensure that
2225 -- the tags of source and target match.
2231 then
2234 Condition =>
2236 Left_Opnd =>
2239 Selector_Name =>
2241 Right_Opnd =>
2244 Selector_Name =>
2249 declare
2253 begin
2254 -- In order to dispatch the call to _assign the type of
2255 -- the actuals must match. Add conversion (if required).
2274 else
2277 -- We can't afford to have destructive Finalization Actions in
2278 -- the Self assignment case, so if the target and the source
2279 -- are not obviously different, code is generated to avoid the
2280 -- self assignment case:
2282 -- if lhs'address /= rhs'address then
2283 -- <code for controlled and/or tagged assignment>
2284 -- end if;
2286 -- Skip this if Restriction (No_Finalization) is active
2289 and then Expand_Ctrl_Actions
2291 then
2294 Condition =>
2296 Left_Opnd =>
2301 Right_Opnd =>
2309 -- We need to set up an exception handler for implementing
2310 -- 7.6.1(18). The remaining adjustments are tackled by the
2311 -- implementation of adjust for record_controllers (see
2312 -- s-finimp.adb).
2314 -- This is skipped if we have no finalization
2316 if Expand_Ctrl_Actions
2318 then
2321 Handled_Statement_Sequence =>
2331 Handled_Statement_Sequence =>
2334 -- If no restrictions on aborts, protect the whole assignment
2335 -- for controlled objects as per 9.8(11).
2338 and then Expand_Ctrl_Actions
2339 and then Abort_Allowed
2340 then
2341 declare
2343 New_Internal_Entity
2346 begin
2354 Expand_At_End_Handler
2359 -- N has been rewritten to a block statement for which it is
2360 -- known by construction that no checks are necessary: analyze
2361 -- it with all checks suppressed.
2367 -- Array types
2370 declare
2373 begin
2375 N_Qualified_Expression)
2376 loop
2384 -- Record types
2390 -- Scalar types. This is where we perform the processing related to the
2391 -- requirements of (RM 13.9.1(9-11)) concerning the handling of invalid
2392 -- scalar values.
2396 -- Case where right side is known valid
2400 -- Here the right side is valid, so it is fine. The case to deal
2401 -- with is when the left side is a local variable reference whose
2402 -- value is not currently known to be valid. If this is the case,
2403 -- and the assignment appears in an unconditional context, then
2404 -- we can mark the left side as now being valid if one of these
2405 -- conditions holds:
2407 -- The expression of the right side has Do_Range_Check set so
2408 -- that we know a range check will be performed. Note that it
2409 -- can be the case that a range check is omitted because we
2410 -- make the assumption that we can assume validity for operands
2411 -- appearing in the right side in determining whether a range
2412 -- check is required
2414 -- The subtype of the right side matches the subtype of the
2415 -- left side. In this case, even though we have not checked
2416 -- the range of the right side, we know it is in range of its
2417 -- subtype if the expression is valid.
2422 then
2425 then
2430 -- Case where right side may be invalid in the sense of the RM
2431 -- reference above. The RM does not require that we check for the
2432 -- validity on an assignment, but it does require that the assignment
2433 -- of an invalid value not cause erroneous behavior.
2435 -- The general approach in GNAT is to use the Is_Known_Valid flag
2436 -- to avoid the need for validity checking on assignments. However
2437 -- in some cases, we have to do validity checking in order to make
2438 -- sure that the setting of this flag is correct.
2440 else
2441 -- Validate right side if we are validating copies
2443 if Validity_Checks_On
2444 and then Validity_Check_Copies
2445 then
2446 -- Skip this if left hand side is an array or record component
2447 -- and elementary component validity checks are suppressed.
2450 and then not Validity_Check_Components
2451 then
2453 else
2457 -- We can propagate this to the left side where appropriate
2462 then
2466 -- Otherwise check to see what should be done
2468 -- If left side is a local variable, then we just set its flag to
2469 -- indicate that its value may no longer be valid, since we are
2470 -- copying a potentially invalid value.
2475 -- Check for case of a nonlocal variable on the left side which
2476 -- is currently known to be valid. In this case, we simply ensure
2477 -- that the right side is valid. We only play the game of copying
2478 -- validity status for local variables, since we are doing this
2479 -- statically, not by tracing the full flow graph.
2483 then
2484 -- Note: If Validity_Checking mode is set to none, we ignore
2485 -- the Ensure_Valid call so don't worry about that case here.
2489 -- In all other cases, we can safely copy an invalid value without
2490 -- worrying about the status of the left side. Since it is not a
2491 -- variable reference it will not be considered
2492 -- as being known to be valid in any case.
2494 else
2500 exception
2505 ------------------------------
2506 -- Expand_N_Block_Statement --
2507 ------------------------------
2509 -- Encode entity names defined in block statement
2512 begin
2516 -----------------------------
2517 -- Expand_N_Case_Statement --
2518 -----------------------------
2529 begin
2530 -- Check for the situation where we know at compile time which branch
2531 -- will be taken
2536 -- Do not consider controlled objects found in a case statement which
2537 -- actually models a case expression because their early finalization
2538 -- will affect the result of the expression.
2544 -- Move statements from this alternative after the case statement.
2545 -- They are already analyzed, so will be skipped by the analyzer.
2549 -- That leaves the case statement as a shell. So now we can kill all
2550 -- other alternatives in the case statement.
2554 declare
2557 begin
2558 -- Loop through case alternatives, skipping pragmas, and skipping
2559 -- the one alternative that we select (and therefore retain).
2565 then
2577 -- Here if the choice is not determined at compile time
2579 declare
2588 begin
2592 else
2596 -- First step is to worry about possible invalid argument. The RM
2597 -- requires (RM 5.4(13)) that if the result is invalid (e.g. it is
2598 -- outside the base range), then Constraint_Error must be raised.
2600 -- Case of validity check required (validity checks are on, the
2601 -- expression is not known to be valid, and the case statement
2602 -- comes from source -- no need to validity check internally
2603 -- generated case statements).
2609 -- If there is only a single alternative, just replace it with the
2610 -- sequence of statements since obviously that is what is going to
2611 -- be executed in all cases.
2617 -- We still need to evaluate the expression if it has any side
2618 -- effects.
2623 -- Do not consider controlled objects found in a case statement
2624 -- which actually models a case expression because their early
2625 -- finalization will affect the result of the expression.
2633 -- That leaves the case statement as a shell. The alternative that
2634 -- will be executed is reset to a null list. So now we can kill
2635 -- the entire case statement.
2641 -- An optimization. If there are only two alternatives, and only
2642 -- a single choice, then rewrite the whole case statement as an
2643 -- if statement, since this can result in subsequent optimizations.
2644 -- This helps not only with case statements in the source of a
2645 -- simple form, but also with generated code (discriminant check
2646 -- functions in particular).
2648 -- Note: it is OK to do this before expanding out choices for any
2649 -- static predicates, since the if statement processing will handle
2650 -- the static predicate case fine.
2661 -- For TRUE, generate "expression", not expression = true
2665 then
2668 -- For FALSE, generate "expression" and switch then/else
2672 then
2677 -- For a range, generate "expression in range"
2684 then
2685 Cond :=
2690 -- A subtype indication is not a legal operator in a membership
2691 -- test, so retrieve its range.
2694 Cond :=
2697 Right_Opnd =>
2698 Relocate_Node
2701 -- For any other subexpression "expression = value"
2703 else
2704 Cond :=
2710 -- Now rewrite the case as an IF
2722 -- If the last alternative is not an Others choice, replace it with
2723 -- an N_Others_Choice. Note that we do not bother to call Analyze on
2724 -- the modified case statement, since it's only effect would be to
2725 -- compute the contents of the Others_Discrete_Choices which is not
2726 -- needed by the back end anyway.
2728 -- The reason for this is that the back end always needs some default
2729 -- for a switch, so if we have not supplied one in the processing
2730 -- above for validity checking, then we need to supply one here.
2734 Set_Others_Discrete_Choices
2739 -- Deal with possible declarations of controlled objects, and also
2740 -- with rewriting choice sequences for static predicate references.
2745 -- Do not consider controlled objects found in a case statement
2746 -- which actually models a case expression because their early
2747 -- finalization will affect the result of the expression.
2762 -----------------------------
2763 -- Expand_N_Exit_Statement --
2764 -----------------------------
2766 -- The only processing required is to deal with a possible C/Fortran
2767 -- boolean value used as the condition for the exit statement.
2770 begin
2774 ----------------------------------
2775 -- Expand_Formal_Container_Loop --
2776 ----------------------------------
2791 begin
2792 -- The expansion resembles the one for Ada containers, but the
2793 -- primitives mention the domain of iteration explicitly, and
2794 -- function First applied to the container yields a cursor directly.
2796 -- Cursor : Cursor_type := First (Container);
2797 -- while Has_Element (Cursor, Container) loop
2798 -- <original loop statements>
2799 -- Cursor := Next (Container, Cursor);
2800 -- end loop;
2802 Build_Formal_Container_Iteration
2808 -- Build block to capture declaration of cursor entity.
2810 Blk_Nod :=
2813 Handled_Statement_Sequence =>
2821 ------------------------------------------
2822 -- Expand_Formal_Container_Element_Loop --
2823 ------------------------------------------
2847 begin
2848 -- For an element iterator, the Element aspect must be present,
2849 -- (this is checked during analysis) and the expansion takes the form:
2851 -- Cursor : Cursor_type := First (Container);
2852 -- Elmt : Element_Type;
2853 -- while Has_Element (Cursor, Container) loop
2854 -- Elmt := Element (Container, Cursor);
2855 -- <original loop statements>
2856 -- Cursor := Next (Container, Cursor);
2857 -- end loop;
2859 Build_Formal_Container_Iteration
2865 -- Declaration for Element.
2867 Elmt_Decl :=
2872 -- The element is only modified in expanded code, so it appears as
2873 -- unassigned to the warning machinery. We must suppress this spurious
2874 -- warning explicitly.
2878 Elmt_Ref :=
2881 Expression =>
2891 -- The loop is rewritten as a block, to hold the element declaration
2893 New_Loop :=
2896 Handled_Statement_Sequence =>
2902 -- The loop parameter is declared by an object declaration, but within
2903 -- the loop we must prevent user assignments to it, so we analyze the
2904 -- declaration and reset the entity kind, before analyzing the rest of
2905 -- the loop;
2914 -----------------------------
2915 -- Expand_N_Goto_Statement --
2916 -----------------------------
2918 -- Add poll before goto if polling active
2921 begin
2925 ---------------------------
2926 -- Expand_N_If_Statement --
2927 ---------------------------
2929 -- First we deal with the case of C and Fortran convention boolean values,
2930 -- with zero/non-zero semantics.
2932 -- Second, we deal with the obvious rewriting for the cases where the
2933 -- condition of the IF is known at compile time to be True or False.
2935 -- Third, we remove elsif parts which have non-empty Condition_Actions and
2936 -- rewrite as independent if statements. For example:
2938 -- if x then xs
2939 -- elsif y then ys
2940 -- ...
2941 -- end if;
2943 -- becomes
2944 --
2945 -- if x then xs
2946 -- else
2947 -- <<condition actions of y>>
2948 -- if y then ys
2949 -- ...
2950 -- end if;
2951 -- end if;
2953 -- This rewriting is needed if at least one elsif part has a non-empty
2954 -- Condition_Actions list. We also do the same processing if there is a
2955 -- constant condition in an elsif part (in conjunction with the first
2956 -- processing step mentioned above, for the recursive call made to deal
2957 -- with the created inner if, this deals with properly optimizing the
2958 -- cases of constant elsif conditions).
2968 -- Indicates whether we want warnings when we delete branches of the
2969 -- if statement based on constant condition analysis. We never want
2970 -- these warnings for expander generated code.
2972 begin
2973 -- Do not consider controlled objects found in an if statement which
2974 -- actually models an if expression because their early finalization
2975 -- will affect the result of the expression.
2983 -- The following loop deals with constant conditions for the IF. We
2984 -- need a loop because as we eliminate False conditions, we grab the
2985 -- first elsif condition and use it as the primary condition.
2989 -- If condition is True, we can simply rewrite the if statement now
2990 -- by replacing it by the series of then statements.
2994 -- All the else parts can be killed
3004 -- If condition is False, then we can delete the condition and
3005 -- the Then statements
3007 else
3008 -- We do not delete the condition if constant condition warnings
3009 -- are enabled, since otherwise we end up deleting the desired
3010 -- warning. Of course the backend will get rid of this True/False
3011 -- test anyway, so nothing is lost here.
3019 -- If there are no elsif statements, then we simply replace the
3020 -- entire if statement by the sequence of else statements.
3025 then
3028 else
3036 -- If there are elsif statements, the first of them becomes the
3037 -- if/then section of the rebuilt if statement This is the case
3038 -- where we loop to reprocess this copied condition.
3040 else
3046 -- Hed might have been captured as the condition determining
3047 -- the current value for an entity. Now it is detached from
3048 -- the tree, so a Current_Value pointer in the condition might
3049 -- need to be updated.
3060 -- Loop through elsif parts, dealing with constant conditions and
3061 -- possible condition actions that are present.
3067 -- Do not consider controlled objects found in an if statement
3068 -- which actually models an if expression because their early
3069 -- finalization will affect the result of the expression.
3077 -- If there are condition actions, then rewrite the if statement
3078 -- as indicated above. We also do the same rewrite for a True or
3079 -- False condition. The further processing of this constant
3080 -- condition is then done by the recursive call to expand the
3081 -- newly created if statement
3085 then
3086 -- Note this is not an implicit if statement, since it is part
3087 -- of an explicit if statement in the source (or of an implicit
3088 -- if statement that has already been tested).
3090 New_If :=
3097 -- Elsif parts for new if come from remaining elsif's of parent
3122 -- No special processing for that elsif part, move to next
3124 else
3130 -- Some more optimizations applicable if we still have an IF statement
3136 -- Another optimization, special cases that can be simplified
3138 -- if expression then
3139 -- return true;
3140 -- else
3141 -- return false;
3142 -- end if;
3144 -- can be changed to:
3146 -- return expression;
3148 -- and
3150 -- if expression then
3151 -- return false;
3152 -- else
3153 -- return true;
3154 -- end if;
3156 -- can be changed to:
3158 -- return not (expression);
3160 -- Only do these optimizations if we are at least at -O1 level and
3161 -- do not do them if control flow optimizations are suppressed.
3165 then
3171 then
3172 declare
3176 begin
3178 and then
3180 then
3181 declare
3185 begin
3187 and then
3189 then
3192 then
3201 then
3204 Expression =>
3206 Right_Opnd =>
3219 --------------------------
3220 -- Expand_Iterator_Loop --
3221 --------------------------
3237 begin
3238 -- Processing for arrays
3247 else
3254 -- Processing for containers
3256 -- For an "of" iterator the name is a container expression, which
3257 -- is transformed into a call to the default iterator.
3259 -- For an iterator of the form "in" the name is a function call
3260 -- that delivers an iterator type.
3262 -- In both cases, analysis of the iterator has introduced an object
3263 -- declaration to capture the domain, so that Container is an entity.
3265 -- The for loop is expanded into a while loop which uses a container
3266 -- specific cursor to desgnate each element.
3268 -- Iter : Iterator_Type := Container.Iterate;
3269 -- Cursor : Cursor_type := First (Iter);
3270 -- while Has_Element (Iter) loop
3271 -- declare
3272 -- -- The block is added when Element_Type is controlled
3274 -- Obj : Pack.Element_Type := Element (Cursor);
3275 -- -- for the "of" loop form
3276 -- begin
3277 -- <original loop statements>
3278 -- end;
3280 -- Cursor := Iter.Next (Cursor);
3281 -- end loop;
3283 -- If "reverse" is present, then the initialization of the cursor
3284 -- uses Last and the step becomes Prev. Pack is the name of the
3285 -- scope where the container package is instantiated.
3287 declare
3295 begin
3296 -- The type of the iterator is the return type of the Iterate
3297 -- function used. For the "of" form this is the default iterator
3298 -- for the type, otherwise it is the type of the explicit
3299 -- function used in the iterator specification. The most common
3300 -- case will be an Iterate function in the container package.
3302 -- The primitive operations of the container type may not be
3303 -- use-visible, so we introduce the name of the enclosing package
3304 -- in the declarations below. The Iterator type is declared in a
3305 -- an instance within the container package itself.
3307 -- If the container type is a derived type, the cursor type is
3308 -- found in the package of the parent type.
3312 else
3318 -- The "of" case uses an internally generated cursor whose type
3319 -- is found in the container package. The domain of iteration
3320 -- is expanded into a call to the default Iterator function, but
3321 -- this expansion does not take place in quantified expressions
3322 -- that are analyzed with expansion disabled, and in that case the
3323 -- type of the iterator must be obtained from the aspect.
3331 function Get_Default_Iterator
3333 -- If the container is a derived type, the aspect holds the
3334 -- parent operation. The required one is a primitive of the
3335 -- derived type and is either inherited or overridden.
3337 --------------------------
3338 -- Get_Default_Iterator --
3339 --------------------------
3341 function Get_Default_Iterator
3343 is
3349 begin
3352 -- A previous version of GNAT allowed indexing aspects to
3353 -- be redefined on derived container types, while the
3354 -- default iterator was inherited from the aprent type.
3355 -- This non-standard extension is preserved temporarily for
3356 -- use by the modelling project under debug flag d.X.
3361 then
3362 Container_Arg :=
3364 Subtype_Mark =>
3365 New_Occurrence_Of
3374 -- The default iterator must be a primitive operation
3375 -- of the type, at the same dispatch slot position.
3383 then
3390 -- default iterator must exist.
3399 -- Start of processing for Handle_Of
3401 begin
3403 Default_Iter :=
3406 else
3412 -- For an container element iterator, the iterator type
3413 -- is obtained from the corresponding aspect, whose return
3414 -- type is descended from the corresponding interface type
3415 -- in some instance of Ada.Iterator_Interfaces. The actuals
3416 -- of that instantiation are Cursor and Has_Element.
3420 -- The iterator type, which is a class_wide type, may itself
3421 -- be derived locally, so the desired instantiation is the
3422 -- scope of the root type of the iterator type.
3426 -- Rewrite domain of iteration as a call to the default
3427 -- iterator for the container type.
3432 Parameter_Associations =>
3436 -- Find cursor type in proper iterator package, which is an
3437 -- instantiation of Iterator_Interfaces.
3448 -- Generate:
3449 -- Id : Element_Type renames Container (Cursor);
3450 -- This assumes that the container type has an indexing
3451 -- operation with Cursor. The check that this operation
3452 -- exists is performed in Check_Container_Indexing.
3454 Decl :=
3457 Subtype_Mark =>
3459 Name =>
3462 Expressions =>
3465 -- The defining identifier in the iterator is user-visible
3466 -- and must be visible in the debugger.
3470 -- If the container does not have a variable indexing aspect,
3471 -- the element is a constant in the loop.
3475 then
3479 -- If the container holds controlled objects, wrap the loop
3480 -- statements and element renaming declaration with a block.
3481 -- This ensures that the result of Element (Cusor) is
3482 -- cleaned up after each iteration of the loop.
3486 -- Generate:
3487 -- declare
3488 -- Id : Element_Type := Element (curosr);
3489 -- begin
3490 -- <original loop statements>
3491 -- end;
3496 Handled_Statement_Sequence =>
3500 -- Elements do not need finalization
3502 else
3507 -- X in Iterate (S) : type of iterator is type of explicitly
3508 -- given Iterate function, and the loop variable is the cursor.
3509 -- It will be assigned in the loop and must be a variable.
3511 else
3517 -- Determine the advancement and initialization steps for the
3518 -- cursor.
3520 -- Analysis of the expanded loop will verify that the container
3521 -- has a reverse iterator.
3527 else
3532 -- For both iterator forms, add a call to the step operation to
3533 -- advance the cursor. Generate:
3535 -- Cursor := Iterator.Next (Cursor);
3537 -- or else
3539 -- Cursor := Next (Cursor);
3541 declare
3544 begin
3545 Rhs :=
3547 Name =>
3561 -- Generate:
3562 -- while Iterator.Has_Element loop
3563 -- <Stats>
3564 -- end loop;
3566 -- Has_Element is the second actual in the iterator package
3568 New_Loop :=
3570 Iteration_Scheme =>
3572 Condition =>
3574 Name =>
3575 New_Occurrence_Of (
3577 Parameter_Associations =>
3583 -- If present, preserve identifier of loop, which can be used in
3584 -- an exit statement in the body.
3590 -- Create the declarations for Iterator and cursor and insert them
3591 -- before the source loop. Given that the domain of iteration is
3592 -- already an entity, the iterator is just a renaming of that
3593 -- entity. Possible optimization ???
3594 -- Generate:
3596 -- I : Iterator_Type renames Container;
3597 -- C : Cursor_Type := Container.[First | Last];
3605 -- Create declaration for cursor
3607 declare
3610 begin
3611 Decl :=
3614 Object_Definition =>
3616 Expression =>
3619 Selector_Name =>
3622 -- The cursor is only modified in expanded code, so it appears
3623 -- as unassigned to the warning machinery. We must suppress
3624 -- this spurious warning explicitly. The cursor's kind is that of
3625 -- the original loop parameter (it is a constant if the domain of
3626 -- iteration is constant).
3635 -- If the range of iteration is given by a function call that
3636 -- returns a container, the finalization actions have been saved
3637 -- in the Condition_Actions of the iterator. Insert them now at
3638 -- the head of the loop.
3649 -------------------------------------
3650 -- Expand_Iterator_Loop_Over_Array --
3651 -------------------------------------
3666 -- Start of processing for Expand_Iterator_Loop_Over_Array
3668 begin
3669 -- for Element of Array loop
3671 -- This case requires an internally generated cursor to iterate over
3672 -- the array.
3677 -- Generate:
3678 -- Element : Component_Type renames Array (Iterator);
3680 Ind_Comp :=
3688 Subtype_Mark =>
3692 -- Mark the loop variable as needing debug info, so that expansion
3693 -- of the renaming will result in Materialize_Entity getting set via
3694 -- Debug_Renaming_Declaration. (This setting is needed here because
3695 -- the setting in Freeze_Entity comes after the expansion, which is
3696 -- too late. ???)
3700 -- for Index in Array loop
3702 -- This case utilizes the already given iterator name
3704 else
3708 -- Generate:
3710 -- for Iterator in [reverse] Array'Range (Array_Dim) loop
3711 -- Element : Component_Type renames Array (Iterator);
3712 -- <original loop statements>
3713 -- end loop;
3715 Core_Loop :=
3717 Iteration_Scheme =>
3719 Loop_Parameter_Specification =>
3722 Discrete_Subtype_Definition =>
3732 -- Processing for multidimensional array
3738 -- Generate the dimension loops starting from the innermost one
3740 -- for Iterator in [reverse] Array'Range (Array_Dim - Dim) loop
3741 -- <core loop>
3742 -- end loop;
3744 Core_Loop :=
3746 Iteration_Scheme =>
3748 Loop_Parameter_Specification =>
3751 Discrete_Subtype_Definition =>
3761 -- Update the previously created object renaming declaration with
3762 -- the new iterator.
3769 -- Inherit the loop identifier from the original loop. This ensures that
3770 -- the scope stack is consistent after the rewriting.
3780 -----------------------------
3781 -- Expand_N_Loop_Statement --
3782 -----------------------------
3784 -- 1. Remove null loop entirely
3785 -- 2. Deal with while condition for C/Fortran boolean
3786 -- 3. Deal with loops with a non-standard enumeration type range
3787 -- 4. Deal with while loops where Condition_Actions is set
3788 -- 5. Deal with loops over predicated subtypes
3789 -- 6. Deal with loops with iterators over arrays and containers
3790 -- 7. Insert polling call if required
3797 begin
3798 -- Delete null loop
3805 -- Deal with condition for C/Fortran Boolean
3811 -- Generate polling call
3817 -- Nothing more to do for plain loop with no iteration scheme
3822 -- Case of for loop (Loop_Parameter_Specification present)
3824 -- Note: we do not have to worry about validity checking of the for loop
3825 -- range bounds here, since they were frozen with constant declarations
3826 -- and it is during that process that the validity checking is done.
3829 declare
3839 begin
3840 -- Deal with loop over predicates
3844 then
3847 -- Handle the case where we have a for loop with the range type
3848 -- being an enumeration type with non-standard representation.
3849 -- In this case we expand:
3851 -- for x in [reverse] a .. b loop
3852 -- ...
3853 -- end loop;
3855 -- to
3857 -- for xP in [reverse] integer
3858 -- range etype'Pos (a) .. etype'Pos (b)
3859 -- loop
3860 -- declare
3861 -- x : constant etype := Pos_To_Rep (xP);
3862 -- begin
3863 -- ...
3864 -- end;
3865 -- end loop;
3869 then
3870 New_Id :=
3874 -- If the type has a contiguous representation, successive
3875 -- values can be generated as offsets from the first literal.
3878 Expr :=
3881 Left_Opnd =>
3885 else
3886 -- Use the constructed array Enum_Pos_To_Rep
3888 Expr :=
3890 Prefix =>
3892 Expressions =>
3896 -- Build declaration for loop identifier
3898 Decls :=
3899 New_List (
3910 Iteration_Scheme =>
3912 Loop_Parameter_Specification =>
3917 Discrete_Subtype_Definition =>
3920 Subtype_Mark =>
3923 Constraint =>
3925 Range_Expression =>
3928 Low_Bound =>
3930 Prefix =>
3936 Relocate_Node
3939 High_Bound =>
3941 Prefix =>
3947 Relocate_Node
3948 (Type_High_Bound
3954 Handled_Statement_Sequence =>
3960 -- The loop parameter's entity must be removed from the loop
3961 -- scope's entity list and rendered invisible, since it will
3962 -- now be located in the new block scope. Any other entities
3963 -- already associated with the loop scope, such as the loop
3964 -- parameter's subtype, will remain there.
3966 -- In an element loop, the loop will contain a declaration for
3967 -- a cursor variable; otherwise the loop id is the first entity
3968 -- in the scope constructed for the loop.
3984 -- Nothing to do with other cases of for loops
3986 else
3991 -- Second case, if we have a while loop with Condition_Actions set, then
3992 -- we change it into a plain loop:
3994 -- while C loop
3995 -- ...
3996 -- end loop;
3998 -- changed to:
4000 -- loop
4001 -- <<condition actions>>
4002 -- exit when not C;
4003 -- ...
4004 -- end loop
4009 then
4010 declare
4013 begin
4014 ES :=
4016 Condition =>
4023 -- This is not an implicit loop, since it is generated in response
4024 -- to the loop statement being processed. If this is itself
4025 -- implicit, the restriction has already been checked. If not,
4026 -- it is an explicit loop.
4037 -- Here to deal with iterator case
4041 then
4044 -- An iterator loop may generate renaming declarations for elements
4045 -- that require debug information. This is the case in particular
4046 -- with element iterators, where debug information must be generated
4047 -- for the temporary that holds the element value. These temporaries
4048 -- are created within a transient block whose local declarations are
4049 -- transferred to the loop, which now has non-trivial local objects.
4053 then
4058 -- When the iteration scheme mentiones attribute 'Loop_Entry, the loop
4059 -- is transformed into a conditional block where the original loop is
4060 -- the sole statement. Inspect the statements of the nested loop for
4061 -- controlled objects.
4072 ----------------------------
4073 -- Expand_Predicated_Loop --
4074 ----------------------------
4076 -- Note: the expander can handle generation of loops over predicated
4077 -- subtypes for both the dynamic and static cases. Depending on what
4078 -- we decide is allowed in Ada 2012 mode and/or extensions allowed
4079 -- mode, the semantic analyzer may disallow one or both forms.
4090 begin
4091 -- Case of iteration over non-static predicate, should not be possible
4092 -- since this is not allowed by the semantics and should have been
4093 -- caught during analysis of the loop statement.
4098 -- If the predicate list is empty, that corresponds to a predicate of
4099 -- False, in which case the loop won't run at all, and we rewrite the
4100 -- entire loop as a null statement.
4106 -- For expansion over a static predicate we generate the following
4108 -- declare
4109 -- J : Ltype := min-val;
4110 -- begin
4111 -- loop
4112 -- body
4113 -- case J is
4114 -- when endpoint => J := startpoint;
4115 -- when endpoint => J := startpoint;
4116 -- ...
4117 -- when max-val => exit;
4118 -- when others => J := Lval'Succ (J);
4119 -- end case;
4120 -- end loop;
4121 -- end;
4123 -- To make this a little clearer, let's take a specific example:
4125 -- type Int is range 1 .. 10;
4126 -- subtype L is Int with
4127 -- predicate => L in 3 | 10 | 5 .. 7;
4128 -- ...
4129 -- for L in StaticP loop
4130 -- Put_Line ("static:" & J'Img);
4131 -- end loop;
4133 -- In this case, the loop is transformed into
4135 -- begin
4136 -- J : L := 3;
4137 -- loop
4138 -- body
4139 -- case J is
4140 -- when 3 => J := 5;
4141 -- when 7 => J := 10;
4142 -- when 10 => exit;
4143 -- when others => J := L'Succ (J);
4144 -- end case;
4145 -- end loop;
4146 -- end;
4148 else
4157 -- Given static expression or static range, returns an identifier
4158 -- whose value is the low bound of the expression value or range.
4161 -- Given static expression or static range, returns an identifier
4162 -- whose value is the high bound of the expression value or range.
4164 ------------
4165 -- Hi_Val --
4166 ------------
4169 begin
4172 else
4178 ------------
4179 -- Lo_Val --
4180 ------------
4183 begin
4186 else
4192 -- Start of processing for Static_Predicate
4194 begin
4195 -- Convert loop identifier to normal variable and reanalyze it so
4196 -- that this conversion works. We have to use the same defining
4197 -- identifier, since there may be references in the loop body.
4202 -- In most loops the loop variable is assigned in various
4203 -- alternatives in the body. However, in the rare case when
4204 -- the range specifies a single element, the loop variable
4205 -- may trigger a spurious warning that is could be constant.
4206 -- This warning might as well be suppressed.
4210 -- Loop to create branches of case statement
4217 else
4218 S :=
4233 -- Add others choice
4235 S :=
4238 Expression =>
4251 -- Construct case statement and append to body statements
4253 Cstm :=
4259 -- Rewrite the loop
4261 D :=
4271 Handled_Statement_Sequence =>
4283 ------------------------------
4284 -- Make_Tag_Ctrl_Assignment --
4285 ------------------------------
4298 and then not Comp_Asn
4301 -- Tags are not saved and restored when VM_Target because VM tags are
4302 -- represented implicitly in objects.
4308 begin
4309 -- Finalize the target of the assignment when controlled
4311 -- We have two exceptions here:
4313 -- 1. If we are in an init proc since it is an initialization more
4314 -- than an assignment.
4316 -- 2. If the left-hand side is a temporary that was not initialized
4317 -- (or the parent part of a temporary since it is the case in
4318 -- extension aggregates). Such a temporary does not come from
4319 -- source. We must examine the original node for the prefix, because
4320 -- it may be a component of an entry formal, in which case it has
4321 -- been rewritten and does not appear to come from source either.
4323 -- Case of init proc
4328 -- The left hand side is an uninitialized temporary object
4333 N_Object_Declaration
4335 then
4338 else
4340 Make_Final_Call
4345 -- Save the Tag in a local variable Tag_Id
4354 Expression =>
4357 Selector_Name =>
4360 -- Otherwise Tag_Id is not used
4362 else
4366 -- Save the Prev and Next fields on .NET/JVM. This is not needed on non
4367 -- VM targets since the fields are not part of the object.
4371 then
4375 -- Generate:
4376 -- Pnn : Root_Controlled_Ptr := Root_Controlled (L).Prev;
4381 Object_Definition =>
4383 Expression =>
4385 Prefix =>
4386 Unchecked_Convert_To
4388 Selector_Name =>
4391 -- Generate:
4392 -- Nnn : Root_Controlled_Ptr := Root_Controlled (L).Next;
4397 Object_Definition =>
4399 Expression =>
4401 Prefix =>
4402 Unchecked_Convert_To
4404 Selector_Name =>
4408 -- If the tagged type has a full rep clause, expand the assignment into
4409 -- component-wise assignments. Mark the node as unanalyzed in order to
4410 -- generate the proper code and propagate this scenario by setting a
4411 -- flag to avoid infinite recursion.
4420 -- Restore the tag
4425 Name =>
4428 Selector_Name =>
4433 -- Restore the Prev and Next fields on .NET/JVM
4437 then
4438 -- Generate:
4439 -- Root_Controlled (L).Prev := Prev_Id;
4443 Name =>
4445 Prefix =>
4446 Unchecked_Convert_To
4448 Selector_Name =>
4452 -- Generate:
4453 -- Root_Controlled (L).Next := Next_Id;
4457 Name =>
4459 Prefix =>
4460 Unchecked_Convert_To
4466 -- Adjust the target after the assignment when controlled (not in the
4467 -- init proc since it is an initialization more than an assignment).
4471 Make_Adjust_Call
4478 exception
4480 -- Could use comment here ???