| 1 | 
         706 | 
         jeremybenn | 
         ------------------------------------------------------------------------------
  | 
      
      
         | 2 | 
          | 
          | 
         --                                                                          --
  | 
      
      
         | 3 | 
          | 
          | 
         --                         GNAT COMPILER COMPONENTS                         --
  | 
      
      
         | 4 | 
          | 
          | 
         --                                                                          --
  | 
      
      
         | 5 | 
          | 
          | 
         --                               C H E C K S                                --
  | 
      
      
         | 6 | 
          | 
          | 
         --                                                                          --
  | 
      
      
         | 7 | 
          | 
          | 
         --                                 S p e c                                  --
  | 
      
      
         | 8 | 
          | 
          | 
         --                                                                          --
  | 
      
      
         | 9 | 
          | 
          | 
         --          Copyright (C) 1992-2011, 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 | 
          | 
          | 
         ------------------------------------------------------------------------------
  | 
      
      
         | 25 | 
          | 
          | 
          
  | 
      
      
         | 26 | 
          | 
          | 
         --  Package containing routines used to deal with runtime checks. These
  | 
      
      
         | 27 | 
          | 
          | 
         --  routines are used both by the semantics and by the expander. In some
  | 
      
      
         | 28 | 
          | 
          | 
         --  cases, checks are enabled simply by setting flags for gigi, and in
  | 
      
      
         | 29 | 
          | 
          | 
         --  other cases the code for the check is expanded.
  | 
      
      
         | 30 | 
          | 
          | 
          
  | 
      
      
         | 31 | 
          | 
          | 
         --  The approach used for range and length checks, in regards to suppressed
  | 
      
      
         | 32 | 
          | 
          | 
         --  checks, is to attempt to detect at compilation time that a constraint
  | 
      
      
         | 33 | 
          | 
          | 
         --  error will occur. If this is detected a warning or error is issued and the
  | 
      
      
         | 34 | 
          | 
          | 
         --  offending expression or statement replaced with a constraint error node.
  | 
      
      
         | 35 | 
          | 
          | 
         --  This always occurs whether checks are suppressed or not. Dynamic range
  | 
      
      
         | 36 | 
          | 
          | 
         --  checks are, of course, not inserted if checks are suppressed.
  | 
      
      
         | 37 | 
          | 
          | 
          
  | 
      
      
         | 38 | 
          | 
          | 
         with Namet;  use Namet;
  | 
      
      
         | 39 | 
          | 
          | 
         with Table;
  | 
      
      
         | 40 | 
          | 
          | 
         with Types;  use Types;
  | 
      
      
         | 41 | 
          | 
          | 
         with Uintp;  use Uintp;
  | 
      
      
         | 42 | 
          | 
          | 
          
  | 
      
      
         | 43 | 
          | 
          | 
         package Checks is
  | 
      
      
         | 44 | 
          | 
          | 
          
  | 
      
      
         | 45 | 
          | 
          | 
            procedure Initialize;
  | 
      
      
         | 46 | 
          | 
          | 
            --  Called for each new main source program, to initialize internal
  | 
      
      
         | 47 | 
          | 
          | 
            --  variables used in the package body of the Checks unit.
  | 
      
      
         | 48 | 
          | 
          | 
          
  | 
      
      
         | 49 | 
          | 
          | 
            function Access_Checks_Suppressed          (E : Entity_Id) return Boolean;
  | 
      
      
         | 50 | 
          | 
          | 
            function Accessibility_Checks_Suppressed   (E : Entity_Id) return Boolean;
  | 
      
      
         | 51 | 
          | 
          | 
            function Alignment_Checks_Suppressed       (E : Entity_Id) return Boolean;
  | 
      
      
         | 52 | 
          | 
          | 
            function Atomic_Synchronization_Disabled   (E : Entity_Id) return Boolean;
  | 
      
      
         | 53 | 
          | 
          | 
            function Discriminant_Checks_Suppressed    (E : Entity_Id) return Boolean;
  | 
      
      
         | 54 | 
          | 
          | 
            function Division_Checks_Suppressed        (E : Entity_Id) return Boolean;
  | 
      
      
         | 55 | 
          | 
          | 
            function Elaboration_Checks_Suppressed     (E : Entity_Id) return Boolean;
  | 
      
      
         | 56 | 
          | 
          | 
            function Index_Checks_Suppressed           (E : Entity_Id) return Boolean;
  | 
      
      
         | 57 | 
          | 
          | 
            function Length_Checks_Suppressed          (E : Entity_Id) return Boolean;
  | 
      
      
         | 58 | 
          | 
          | 
            function Overflow_Checks_Suppressed        (E : Entity_Id) return Boolean;
  | 
      
      
         | 59 | 
          | 
          | 
            function Range_Checks_Suppressed           (E : Entity_Id) return Boolean;
  | 
      
      
         | 60 | 
          | 
          | 
            function Storage_Checks_Suppressed         (E : Entity_Id) return Boolean;
  | 
      
      
         | 61 | 
          | 
          | 
            function Tag_Checks_Suppressed             (E : Entity_Id) return Boolean;
  | 
      
      
         | 62 | 
          | 
          | 
            function Validity_Checks_Suppressed        (E : Entity_Id) return Boolean;
  | 
      
      
         | 63 | 
          | 
          | 
            --  These functions check to see if the named check is suppressed, either
  | 
      
      
         | 64 | 
          | 
          | 
            --  by an active scope suppress setting, or because the check has been
  | 
      
      
         | 65 | 
          | 
          | 
            --  specifically suppressed for the given entity. If no entity is relevant
  | 
      
      
         | 66 | 
          | 
          | 
            --  for the current check, then Empty is used as an argument. Note: the
  | 
      
      
         | 67 | 
          | 
          | 
            --  reason we insist on specifying Empty is to force the caller to think
  | 
      
      
         | 68 | 
          | 
          | 
            --  about whether there is any relevant entity that should be checked.
  | 
      
      
         | 69 | 
          | 
          | 
          
  | 
      
      
         | 70 | 
          | 
          | 
            -------------------------------------------
  | 
      
      
         | 71 | 
          | 
          | 
            -- Procedures to Activate Checking Flags --
  | 
      
      
         | 72 | 
          | 
          | 
            -------------------------------------------
  | 
      
      
         | 73 | 
          | 
          | 
          
  | 
      
      
         | 74 | 
          | 
          | 
            procedure Activate_Division_Check (N : Node_Id);
  | 
      
      
         | 75 | 
          | 
          | 
            pragma Inline (Activate_Division_Check);
  | 
      
      
         | 76 | 
          | 
          | 
            --  Sets Do_Division_Check flag in node N, and handles possible local raise.
  | 
      
      
         | 77 | 
          | 
          | 
            --  Always call this routine rather than calling Set_Do_Division_Check to
  | 
      
      
         | 78 | 
          | 
          | 
            --  set an explicit value of True, to ensure handling the local raise case.
  | 
      
      
         | 79 | 
          | 
          | 
          
  | 
      
      
         | 80 | 
          | 
          | 
            procedure Activate_Overflow_Check (N : Node_Id);
  | 
      
      
         | 81 | 
          | 
          | 
            pragma Inline (Activate_Overflow_Check);
  | 
      
      
         | 82 | 
          | 
          | 
            --  Sets Do_Overflow_Check flag in node N, and handles possible local raise.
  | 
      
      
         | 83 | 
          | 
          | 
            --  Always call this routine rather than calling Set_Do_Overflow_Check to
  | 
      
      
         | 84 | 
          | 
          | 
            --  set an explicit value of True, to ensure handling the local raise case.
  | 
      
      
         | 85 | 
          | 
          | 
          
  | 
      
      
         | 86 | 
          | 
          | 
            procedure Activate_Range_Check (N : Node_Id);
  | 
      
      
         | 87 | 
          | 
          | 
            pragma Inline (Activate_Range_Check);
  | 
      
      
         | 88 | 
          | 
          | 
            --  Sets Do_Range_Check flag in node N, and handles possible local raise
  | 
      
      
         | 89 | 
          | 
          | 
            --  Always call this routine rather than calling Set_Do_Range_Check to
  | 
      
      
         | 90 | 
          | 
          | 
            --  set an explicit value of True, to ensure handling the local raise case.
  | 
      
      
         | 91 | 
          | 
          | 
          
  | 
      
      
         | 92 | 
          | 
          | 
            --------------------------------
  | 
      
      
         | 93 | 
          | 
          | 
            -- Procedures to Apply Checks --
  | 
      
      
         | 94 | 
          | 
          | 
            --------------------------------
  | 
      
      
         | 95 | 
          | 
          | 
          
  | 
      
      
         | 96 | 
          | 
          | 
            --  General note on following checks. These checks are always active if
  | 
      
      
         | 97 | 
          | 
          | 
            --  Expander_Active and not Inside_A_Generic. They are inactive and have
  | 
      
      
         | 98 | 
          | 
          | 
            --  no effect Inside_A_Generic. In the case where not Expander_Active
  | 
      
      
         | 99 | 
          | 
          | 
            --  and not Inside_A_Generic, most of them are inactive, but some of them
  | 
      
      
         | 100 | 
          | 
          | 
            --  operate anyway since they may generate useful compile time warnings.
  | 
      
      
         | 101 | 
          | 
          | 
          
  | 
      
      
         | 102 | 
          | 
          | 
            procedure Apply_Access_Check (N : Node_Id);
  | 
      
      
         | 103 | 
          | 
          | 
            --  Determines whether an expression node requires a runtime access
  | 
      
      
         | 104 | 
          | 
          | 
            --  check and if so inserts the appropriate run-time check.
  | 
      
      
         | 105 | 
          | 
          | 
          
  | 
      
      
         | 106 | 
          | 
          | 
            procedure Apply_Accessibility_Check
  | 
      
      
         | 107 | 
          | 
          | 
              (N           : Node_Id;
  | 
      
      
         | 108 | 
          | 
          | 
               Typ         : Entity_Id;
  | 
      
      
         | 109 | 
          | 
          | 
               Insert_Node : Node_Id);
  | 
      
      
         | 110 | 
          | 
          | 
            --  Given a name N denoting an access parameter, emits a run-time
  | 
      
      
         | 111 | 
          | 
          | 
            --  accessibility check (if necessary), checking that the level of
  | 
      
      
         | 112 | 
          | 
          | 
            --  the object denoted by the access parameter is not deeper than the
  | 
      
      
         | 113 | 
          | 
          | 
            --  level of the type Typ. Program_Error is raised if the check fails.
  | 
      
      
         | 114 | 
          | 
          | 
            --  Insert_Node indicates the node where the check should be inserted.
  | 
      
      
         | 115 | 
          | 
          | 
          
  | 
      
      
         | 116 | 
          | 
          | 
            procedure Apply_Address_Clause_Check (E : Entity_Id; N : Node_Id);
  | 
      
      
         | 117 | 
          | 
          | 
            --  E is the entity for an object which has an address clause. If checks
  | 
      
      
         | 118 | 
          | 
          | 
            --  are enabled, then this procedure generates a check that the specified
  | 
      
      
         | 119 | 
          | 
          | 
            --  address has an alignment consistent with the alignment of the object,
  | 
      
      
         | 120 | 
          | 
          | 
            --  raising PE if this is not the case. The resulting check (if one is
  | 
      
      
         | 121 | 
          | 
          | 
            --  generated) is inserted before node N. check is also made for the case of
  | 
      
      
         | 122 | 
          | 
          | 
            --  a clear overlay situation that the size of the overlaying object is not
  | 
      
      
         | 123 | 
          | 
          | 
            --  larger than the overlaid object.
  | 
      
      
         | 124 | 
          | 
          | 
          
  | 
      
      
         | 125 | 
          | 
          | 
            procedure Apply_Arithmetic_Overflow_Check (N : Node_Id);
  | 
      
      
         | 126 | 
          | 
          | 
            --  Given a binary arithmetic operator (+ - *) expand a software integer
  | 
      
      
         | 127 | 
          | 
          | 
            --  overflow check using range checks on a larger checking type or a call
  | 
      
      
         | 128 | 
          | 
          | 
            --  to an appropriate runtime routine. This is used for all three operators
  | 
      
      
         | 129 | 
          | 
          | 
            --  for the signed integer case, and for +/- in the fixed-point case. The
  | 
      
      
         | 130 | 
          | 
          | 
            --  check is expanded only if Software_Overflow_Checking is enabled and
  | 
      
      
         | 131 | 
          | 
          | 
            --  Do_Overflow_Check is set on node N. Note that divide is handled
  | 
      
      
         | 132 | 
          | 
          | 
            --  separately using Apply_Arithmetic_Divide_Overflow_Check.
  | 
      
      
         | 133 | 
          | 
          | 
          
  | 
      
      
         | 134 | 
          | 
          | 
            procedure Apply_Constraint_Check
  | 
      
      
         | 135 | 
          | 
          | 
              (N          : Node_Id;
  | 
      
      
         | 136 | 
          | 
          | 
               Typ        : Entity_Id;
  | 
      
      
         | 137 | 
          | 
          | 
               No_Sliding : Boolean := False);
  | 
      
      
         | 138 | 
          | 
          | 
            --  Top-level procedure, calls all the others depending on the class of
  | 
      
      
         | 139 | 
          | 
          | 
            --  Typ. Checks that expression N satisfies the constraint of type Typ.
  | 
      
      
         | 140 | 
          | 
          | 
            --  No_Sliding is only relevant for constrained array types, if set to
  | 
      
      
         | 141 | 
          | 
          | 
            --  True, it checks that indexes are in range.
  | 
      
      
         | 142 | 
          | 
          | 
          
  | 
      
      
         | 143 | 
          | 
          | 
            procedure Apply_Discriminant_Check
  | 
      
      
         | 144 | 
          | 
          | 
              (N   : Node_Id;
  | 
      
      
         | 145 | 
          | 
          | 
               Typ : Entity_Id;
  | 
      
      
         | 146 | 
          | 
          | 
               Lhs : Node_Id := Empty);
  | 
      
      
         | 147 | 
          | 
          | 
            --  Given an expression N of a discriminated type, or of an access type
  | 
      
      
         | 148 | 
          | 
          | 
            --  whose designated type is a discriminanted type, generates a check to
  | 
      
      
         | 149 | 
          | 
          | 
            --  ensure that the expression can be converted to the subtype given as
  | 
      
      
         | 150 | 
          | 
          | 
            --  the second parameter. Lhs is empty except in the case of assignments,
  | 
      
      
         | 151 | 
          | 
          | 
            --  where the target object may be needed to determine the subtype to
  | 
      
      
         | 152 | 
          | 
          | 
            --  check against (such as the cases of unconstrained formal parameters
  | 
      
      
         | 153 | 
          | 
          | 
            --  and unconstrained aliased objects). For the case of unconstrained
  | 
      
      
         | 154 | 
          | 
          | 
            --  formals, the check is performed only if the corresponding actual is
  | 
      
      
         | 155 | 
          | 
          | 
            --  constrained, i.e., whether Lhs'Constrained is True.
  | 
      
      
         | 156 | 
          | 
          | 
          
  | 
      
      
         | 157 | 
          | 
          | 
            procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id);
  | 
      
      
         | 158 | 
          | 
          | 
            --  N is an expression to which a predicate check may need to be applied
  | 
      
      
         | 159 | 
          | 
          | 
            --  for Typ, if Typ has a predicate function. The check is applied only
  | 
      
      
         | 160 | 
          | 
          | 
            --  if the type of N does not match Typ.
  | 
      
      
         | 161 | 
          | 
          | 
          
  | 
      
      
         | 162 | 
          | 
          | 
            function Build_Discriminant_Checks
  | 
      
      
         | 163 | 
          | 
          | 
              (N     : Node_Id;
  | 
      
      
         | 164 | 
          | 
          | 
               T_Typ : Entity_Id)
  | 
      
      
         | 165 | 
          | 
          | 
               return  Node_Id;
  | 
      
      
         | 166 | 
          | 
          | 
            --  Subsidiary routine for Apply_Discriminant_Check. Builds the expression
  | 
      
      
         | 167 | 
          | 
          | 
            --  that compares discriminants of the expression with discriminants of the
  | 
      
      
         | 168 | 
          | 
          | 
            --  type. Also used directly for membership tests (see Exp_Ch4.Expand_N_In).
  | 
      
      
         | 169 | 
          | 
          | 
          
  | 
      
      
         | 170 | 
          | 
          | 
            procedure Apply_Divide_Check (N : Node_Id);
  | 
      
      
         | 171 | 
          | 
          | 
            --  The node kind is N_Op_Divide, N_Op_Mod, or N_Op_Rem. An appropriate
  | 
      
      
         | 172 | 
          | 
          | 
            --  check is generated to ensure that the right operand is non-zero. In
  | 
      
      
         | 173 | 
          | 
          | 
            --  the divide case, we also check that we do not have the annoying case
  | 
      
      
         | 174 | 
          | 
          | 
            --  of the largest negative number divided by minus one.
  | 
      
      
         | 175 | 
          | 
          | 
          
  | 
      
      
         | 176 | 
          | 
          | 
            procedure Apply_Type_Conversion_Checks (N : Node_Id);
  | 
      
      
         | 177 | 
          | 
          | 
            --  N is an N_Type_Conversion node. A type conversion actually involves
  | 
      
      
         | 178 | 
          | 
          | 
            --  two sorts of checks. The first check is the checks that ensures that
  | 
      
      
         | 179 | 
          | 
          | 
            --  the operand in the type conversion fits onto the base type of the
  | 
      
      
         | 180 | 
          | 
          | 
            --  subtype it is being converted to (see RM 4.6 (28)-(50)). The second
  | 
      
      
         | 181 | 
          | 
          | 
            --  check is there to ensure that once the operand has been converted to
  | 
      
      
         | 182 | 
          | 
          | 
            --  a value of the target type, this converted value meets the
  | 
      
      
         | 183 | 
          | 
          | 
            --  constraints imposed by the target subtype (see RM 4.6 (51)).
  | 
      
      
         | 184 | 
          | 
          | 
          
  | 
      
      
         | 185 | 
          | 
          | 
            procedure Apply_Universal_Integer_Attribute_Checks (N : Node_Id);
  | 
      
      
         | 186 | 
          | 
          | 
            --  The argument N is an attribute reference node intended for processing
  | 
      
      
         | 187 | 
          | 
          | 
            --  by gigi. The attribute is one that returns a universal integer, but
  | 
      
      
         | 188 | 
          | 
          | 
            --  the attribute reference node is currently typed with the expected
  | 
      
      
         | 189 | 
          | 
          | 
            --  result type. This routine deals with range and overflow checks needed
  | 
      
      
         | 190 | 
          | 
          | 
            --  to make sure that the universal result is in range.
  | 
      
      
         | 191 | 
          | 
          | 
          
  | 
      
      
         | 192 | 
          | 
          | 
            procedure Determine_Range
  | 
      
      
         | 193 | 
          | 
          | 
              (N            : Node_Id;
  | 
      
      
         | 194 | 
          | 
          | 
               OK           : out Boolean;
  | 
      
      
         | 195 | 
          | 
          | 
               Lo           : out Uint;
  | 
      
      
         | 196 | 
          | 
          | 
               Hi           : out Uint;
  | 
      
      
         | 197 | 
          | 
          | 
               Assume_Valid : Boolean := False);
  | 
      
      
         | 198 | 
          | 
          | 
            --  N is a node for a subexpression. If N is of a discrete type with no
  | 
      
      
         | 199 | 
          | 
          | 
            --  error indications, and no other peculiarities (e.g. missing type
  | 
      
      
         | 200 | 
          | 
          | 
            --  fields), then OK is True on return, and Lo and Hi are set to a
  | 
      
      
         | 201 | 
          | 
          | 
            --  conservative estimate of the possible range of values of N. Thus if OK
  | 
      
      
         | 202 | 
          | 
          | 
            --  is True on return, the value of the subexpression N is known to like in
  | 
      
      
         | 203 | 
          | 
          | 
            --  the range Lo .. Hi (inclusive). If the expression is not of a discrete
  | 
      
      
         | 204 | 
          | 
          | 
            --  type, or some kind of error condition is detected, then OK is False on
  | 
      
      
         | 205 | 
          | 
          | 
            --  exit, and Lo/Hi are set to No_Uint. Thus the significance of OK being
  | 
      
      
         | 206 | 
          | 
          | 
            --  False on return is that no useful information is available on the range
  | 
      
      
         | 207 | 
          | 
          | 
            --  of the expression. Assume_Valid determines whether the processing is
  | 
      
      
         | 208 | 
          | 
          | 
            --  allowed to assume that values are in range of their subtypes. If it is
  | 
      
      
         | 209 | 
          | 
          | 
            --  set to True, then this assumption is valid, if False, then processing
  | 
      
      
         | 210 | 
          | 
          | 
            --  is done using base types to allow invalid values.
  | 
      
      
         | 211 | 
          | 
          | 
          
  | 
      
      
         | 212 | 
          | 
          | 
            procedure Install_Null_Excluding_Check (N : Node_Id);
  | 
      
      
         | 213 | 
          | 
          | 
            --  Determines whether an access node requires a runtime access check and
  | 
      
      
         | 214 | 
          | 
          | 
            --  if so inserts the appropriate run-time check.
  | 
      
      
         | 215 | 
          | 
          | 
          
  | 
      
      
         | 216 | 
          | 
          | 
            -------------------------------------------------------
  | 
      
      
         | 217 | 
          | 
          | 
            -- Control and Optimization of Range/Overflow Checks --
  | 
      
      
         | 218 | 
          | 
          | 
            -------------------------------------------------------
  | 
      
      
         | 219 | 
          | 
          | 
          
  | 
      
      
         | 220 | 
          | 
          | 
            --  Range checks are controlled by the Do_Range_Check flag. The front end
  | 
      
      
         | 221 | 
          | 
          | 
            --  is responsible for setting this flag in relevant nodes. Originally
  | 
      
      
         | 222 | 
          | 
          | 
            --  the back end generated all corresponding range checks. But later on
  | 
      
      
         | 223 | 
          | 
          | 
            --  we decided to generate many range checks in the front end. We are now
  | 
      
      
         | 224 | 
          | 
          | 
            --  in the transitional phase where some of these checks are still done
  | 
      
      
         | 225 | 
          | 
          | 
            --  by the back end, but many are done by the front end. It is possible
  | 
      
      
         | 226 | 
          | 
          | 
            --  that in the future we might move all the checks to the front end. The
  | 
      
      
         | 227 | 
          | 
          | 
            --  main remaining back end checks are for subscript checking.
  | 
      
      
         | 228 | 
          | 
          | 
          
  | 
      
      
         | 229 | 
          | 
          | 
            --  Overflow checks are similarly controlled by the Do_Overflow_Check flag.
  | 
      
      
         | 230 | 
          | 
          | 
            --  The difference here is that if back end overflow checks are inactive
  | 
      
      
         | 231 | 
          | 
          | 
            --  (Backend_Overflow_Checks_On_Target set False), then the actual overflow
  | 
      
      
         | 232 | 
          | 
          | 
            --  checks are generated by the front end, but if back end overflow checks
  | 
      
      
         | 233 | 
          | 
          | 
            --  are active (Backend_Overflow_Checks_On_Target set True), then the back
  | 
      
      
         | 234 | 
          | 
          | 
            --  end does generate the checks.
  | 
      
      
         | 235 | 
          | 
          | 
          
  | 
      
      
         | 236 | 
          | 
          | 
            --  The following two routines are used to set these flags, they allow
  | 
      
      
         | 237 | 
          | 
          | 
            --  for the possibility of eliminating checks. Checks can be eliminated
  | 
      
      
         | 238 | 
          | 
          | 
            --  if an identical check has already been performed.
  | 
      
      
         | 239 | 
          | 
          | 
          
  | 
      
      
         | 240 | 
          | 
          | 
            procedure Enable_Overflow_Check (N : Node_Id);
  | 
      
      
         | 241 | 
          | 
          | 
            --  First this routine determines if an overflow check is needed by doing
  | 
      
      
         | 242 | 
          | 
          | 
            --  an appropriate range check. If a check is not needed, then the call
  | 
      
      
         | 243 | 
          | 
          | 
            --  has no effect. If a check is needed then this routine sets the flag
  | 
      
      
         | 244 | 
          | 
          | 
            --  Do_Overflow_Check in node N to True, unless it can be determined that
  | 
      
      
         | 245 | 
          | 
          | 
            --  the check is not needed. The only condition under which this is the
  | 
      
      
         | 246 | 
          | 
          | 
            --  case is if there was an identical check earlier on.
  | 
      
      
         | 247 | 
          | 
          | 
          
  | 
      
      
         | 248 | 
          | 
          | 
            procedure Enable_Range_Check (N : Node_Id);
  | 
      
      
         | 249 | 
          | 
          | 
            --  Set Do_Range_Check flag in node N True, unless it can be determined
  | 
      
      
         | 250 | 
          | 
          | 
            --  that the check is not needed. The only condition under which this is
  | 
      
      
         | 251 | 
          | 
          | 
            --  the case is if there was an identical check earlier on. This routine
  | 
      
      
         | 252 | 
          | 
          | 
            --  is not responsible for doing range analysis to determine whether or
  | 
      
      
         | 253 | 
          | 
          | 
            --  not such a check is needed -- the caller is expected to do this. The
  | 
      
      
         | 254 | 
          | 
          | 
            --  one other case in which the request to set the flag is ignored is
  | 
      
      
         | 255 | 
          | 
          | 
            --  when Kill_Range_Check is set in an N_Unchecked_Conversion node.
  | 
      
      
         | 256 | 
          | 
          | 
          
  | 
      
      
         | 257 | 
          | 
          | 
            --  The following routines are used to keep track of processing sequences
  | 
      
      
         | 258 | 
          | 
          | 
            --  of statements (e.g. the THEN statements of an IF statement). A check
  | 
      
      
         | 259 | 
          | 
          | 
            --  that appears within such a sequence can eliminate an identical check
  | 
      
      
         | 260 | 
          | 
          | 
            --  within this sequence of statements. However, after the end of the
  | 
      
      
         | 261 | 
          | 
          | 
            --  sequence of statements, such a check is no longer of interest, since
  | 
      
      
         | 262 | 
          | 
          | 
            --  it may not have been executed.
  | 
      
      
         | 263 | 
          | 
          | 
          
  | 
      
      
         | 264 | 
          | 
          | 
            procedure Conditional_Statements_Begin;
  | 
      
      
         | 265 | 
          | 
          | 
            --  This call marks the start of processing of a sequence of statements.
  | 
      
      
         | 266 | 
          | 
          | 
            --  Every call to this procedure must be followed by a matching call to
  | 
      
      
         | 267 | 
          | 
          | 
            --  Conditional_Statements_End.
  | 
      
      
         | 268 | 
          | 
          | 
          
  | 
      
      
         | 269 | 
          | 
          | 
            procedure Conditional_Statements_End;
  | 
      
      
         | 270 | 
          | 
          | 
            --  This call removes from consideration all saved checks since the
  | 
      
      
         | 271 | 
          | 
          | 
            --  corresponding call to Conditional_Statements_Begin. These two
  | 
      
      
         | 272 | 
          | 
          | 
            --  procedures operate in a stack like manner.
  | 
      
      
         | 273 | 
          | 
          | 
          
  | 
      
      
         | 274 | 
          | 
          | 
            --  The mechanism for optimizing checks works by remembering checks
  | 
      
      
         | 275 | 
          | 
          | 
            --  that have already been made, but certain conditions, for example
  | 
      
      
         | 276 | 
          | 
          | 
            --  an assignment to a variable involved in a check, may mean that the
  | 
      
      
         | 277 | 
          | 
          | 
            --  remembered check is no longer valid, in the sense that if the same
  | 
      
      
         | 278 | 
          | 
          | 
            --  expression appears again, another check is required because the
  | 
      
      
         | 279 | 
          | 
          | 
            --  value may have changed.
  | 
      
      
         | 280 | 
          | 
          | 
          
  | 
      
      
         | 281 | 
          | 
          | 
            --  The following routines are used to note conditions which may render
  | 
      
      
         | 282 | 
          | 
          | 
            --  some or all of the stored and remembered checks to be invalidated.
  | 
      
      
         | 283 | 
          | 
          | 
          
  | 
      
      
         | 284 | 
          | 
          | 
            procedure Kill_Checks (V : Entity_Id);
  | 
      
      
         | 285 | 
          | 
          | 
            --  This procedure records an assignment or other condition that causes
  | 
      
      
         | 286 | 
          | 
          | 
            --  the value of the variable to be changed, invalidating any stored
  | 
      
      
         | 287 | 
          | 
          | 
            --  checks that reference the value. Note that all such checks must
  | 
      
      
         | 288 | 
          | 
          | 
            --  be discarded, even if they are not in the current statement range.
  | 
      
      
         | 289 | 
          | 
          | 
          
  | 
      
      
         | 290 | 
          | 
          | 
            procedure Kill_All_Checks;
  | 
      
      
         | 291 | 
          | 
          | 
            --  This procedure kills all remembered checks
  | 
      
      
         | 292 | 
          | 
          | 
          
  | 
      
      
         | 293 | 
          | 
          | 
            -----------------------------
  | 
      
      
         | 294 | 
          | 
          | 
            -- Length and Range Checks --
  | 
      
      
         | 295 | 
          | 
          | 
            -----------------------------
  | 
      
      
         | 296 | 
          | 
          | 
          
  | 
      
      
         | 297 | 
          | 
          | 
            --  In the following procedures, there are three arguments which have
  | 
      
      
         | 298 | 
          | 
          | 
            --  a common meaning as follows:
  | 
      
      
         | 299 | 
          | 
          | 
          
  | 
      
      
         | 300 | 
          | 
          | 
            --    Expr        The expression to be checked. If a check is required,
  | 
      
      
         | 301 | 
          | 
          | 
            --                the appropriate flag will be placed on this node. Whether
  | 
      
      
         | 302 | 
          | 
          | 
            --                this node is further examined depends on the setting of
  | 
      
      
         | 303 | 
          | 
          | 
            --                the parameter Source_Typ, as described below.
  | 
      
      
         | 304 | 
          | 
          | 
          
  | 
      
      
         | 305 | 
          | 
          | 
            --    ??? Apply_Length_Check and Apply_Range_Check do not have an Expr
  | 
      
      
         | 306 | 
          | 
          | 
            --        formal
  | 
      
      
         | 307 | 
          | 
          | 
          
  | 
      
      
         | 308 | 
          | 
          | 
            --    ??? Apply_Length_Check and Apply_Range_Check have a Ck_Node formal
  | 
      
      
         | 309 | 
          | 
          | 
            --        which is undocumented, is it the same as Expr?
  | 
      
      
         | 310 | 
          | 
          | 
          
  | 
      
      
         | 311 | 
          | 
          | 
            --    Target_Typ  The target type on which the check is to be based. For
  | 
      
      
         | 312 | 
          | 
          | 
            --                example, if we have a scalar range check, then the check
  | 
      
      
         | 313 | 
          | 
          | 
            --                is that we are in range of this type.
  | 
      
      
         | 314 | 
          | 
          | 
          
  | 
      
      
         | 315 | 
          | 
          | 
            --    Source_Typ  Normally Empty, but can be set to a type, in which case
  | 
      
      
         | 316 | 
          | 
          | 
            --                this type is used for the check, see below.
  | 
      
      
         | 317 | 
          | 
          | 
          
  | 
      
      
         | 318 | 
          | 
          | 
            --  The checks operate in one of two modes:
  | 
      
      
         | 319 | 
          | 
          | 
          
  | 
      
      
         | 320 | 
          | 
          | 
            --    If Source_Typ is Empty, then the node Expr is examined, at the very
  | 
      
      
         | 321 | 
          | 
          | 
            --    least to get the source subtype. In addition for some of the checks,
  | 
      
      
         | 322 | 
          | 
          | 
            --    the actual form of the node may be examined. For example, a node of
  | 
      
      
         | 323 | 
          | 
          | 
            --    type Integer whose actual form is an Integer conversion from a type
  | 
      
      
         | 324 | 
          | 
          | 
            --    with range 0 .. 3 can be determined to have a value in range 0 .. 3.
  | 
      
      
         | 325 | 
          | 
          | 
          
  | 
      
      
         | 326 | 
          | 
          | 
            --    If Source_Typ is given, then nothing can be assumed about the Expr,
  | 
      
      
         | 327 | 
          | 
          | 
            --    and indeed its contents are not examined. In this case the check is
  | 
      
      
         | 328 | 
          | 
          | 
            --    based on the assumption that Expr can be an arbitrary value of the
  | 
      
      
         | 329 | 
          | 
          | 
            --    given Source_Typ.
  | 
      
      
         | 330 | 
          | 
          | 
          
  | 
      
      
         | 331 | 
          | 
          | 
            --  Currently, the only case in which a Source_Typ is explicitly supplied
  | 
      
      
         | 332 | 
          | 
          | 
            --  is for the case of Out and In_Out parameters, where, for the conversion
  | 
      
      
         | 333 | 
          | 
          | 
            --  on return (the Out direction), the types must be reversed. This is
  | 
      
      
         | 334 | 
          | 
          | 
            --  handled by the caller.
  | 
      
      
         | 335 | 
          | 
          | 
          
  | 
      
      
         | 336 | 
          | 
          | 
            procedure Apply_Length_Check
  | 
      
      
         | 337 | 
          | 
          | 
              (Ck_Node    : Node_Id;
  | 
      
      
         | 338 | 
          | 
          | 
               Target_Typ : Entity_Id;
  | 
      
      
         | 339 | 
          | 
          | 
               Source_Typ : Entity_Id := Empty);
  | 
      
      
         | 340 | 
          | 
          | 
            --  This procedure builds a sequence of declarations to do a length check
  | 
      
      
         | 341 | 
          | 
          | 
            --  that checks if the lengths of the two arrays Target_Typ and source type
  | 
      
      
         | 342 | 
          | 
          | 
            --  are the same. The resulting actions are inserted at Node using a call
  | 
      
      
         | 343 | 
          | 
          | 
            --  to Insert_Actions.
  | 
      
      
         | 344 | 
          | 
          | 
            --
  | 
      
      
         | 345 | 
          | 
          | 
            --  For access types, the Directly_Designated_Type is retrieved and
  | 
      
      
         | 346 | 
          | 
          | 
            --  processing continues as enumerated above, with a guard against null
  | 
      
      
         | 347 | 
          | 
          | 
            --  values.
  | 
      
      
         | 348 | 
          | 
          | 
            --
  | 
      
      
         | 349 | 
          | 
          | 
            --  Note: calls to Apply_Length_Check currently never supply an explicit
  | 
      
      
         | 350 | 
          | 
          | 
            --  Source_Typ parameter, but Apply_Length_Check takes this parameter and
  | 
      
      
         | 351 | 
          | 
          | 
            --  processes it as described above for consistency with the other routines
  | 
      
      
         | 352 | 
          | 
          | 
            --  in this section.
  | 
      
      
         | 353 | 
          | 
          | 
          
  | 
      
      
         | 354 | 
          | 
          | 
            procedure Apply_Range_Check
  | 
      
      
         | 355 | 
          | 
          | 
              (Ck_Node    : Node_Id;
  | 
      
      
         | 356 | 
          | 
          | 
               Target_Typ : Entity_Id;
  | 
      
      
         | 357 | 
          | 
          | 
               Source_Typ : Entity_Id := Empty);
  | 
      
      
         | 358 | 
          | 
          | 
            --  For a Node of kind N_Range, constructs a range check action that tests
  | 
      
      
         | 359 | 
          | 
          | 
            --  first that the range is not null and then that the range is contained in
  | 
      
      
         | 360 | 
          | 
          | 
            --  the Target_Typ range.
  | 
      
      
         | 361 | 
          | 
          | 
            --
  | 
      
      
         | 362 | 
          | 
          | 
            --  For scalar types, constructs a range check action that first tests that
  | 
      
      
         | 363 | 
          | 
          | 
            --  the expression is contained in the Target_Typ range. The difference
  | 
      
      
         | 364 | 
          | 
          | 
            --  between this and Apply_Scalar_Range_Check is that the latter generates
  | 
      
      
         | 365 | 
          | 
          | 
            --  the actual checking code in gigi against the Etype of the expression.
  | 
      
      
         | 366 | 
          | 
          | 
            --
  | 
      
      
         | 367 | 
          | 
          | 
            --  For constrained array types, construct series of range check actions
  | 
      
      
         | 368 | 
          | 
          | 
            --  to check that each Expr range is properly contained in the range of
  | 
      
      
         | 369 | 
          | 
          | 
            --  Target_Typ.
  | 
      
      
         | 370 | 
          | 
          | 
            --
  | 
      
      
         | 371 | 
          | 
          | 
            --  For a type conversion to an unconstrained array type, constructs a range
  | 
      
      
         | 372 | 
          | 
          | 
            --  check action to check that the bounds of the source type are within the
  | 
      
      
         | 373 | 
          | 
          | 
            --  constraints imposed by the Target_Typ.
  | 
      
      
         | 374 | 
          | 
          | 
            --
  | 
      
      
         | 375 | 
          | 
          | 
            --  For access types, the Directly_Designated_Type is retrieved and
  | 
      
      
         | 376 | 
          | 
          | 
            --  processing continues as enumerated above, with a guard against null
  | 
      
      
         | 377 | 
          | 
          | 
            --  values.
  | 
      
      
         | 378 | 
          | 
          | 
            --
  | 
      
      
         | 379 | 
          | 
          | 
            --  The source type is used by type conversions to unconstrained array
  | 
      
      
         | 380 | 
          | 
          | 
            --  types to retrieve the corresponding bounds.
  | 
      
      
         | 381 | 
          | 
          | 
          
  | 
      
      
         | 382 | 
          | 
          | 
            procedure Apply_Static_Length_Check
  | 
      
      
         | 383 | 
          | 
          | 
              (Expr       : Node_Id;
  | 
      
      
         | 384 | 
          | 
          | 
               Target_Typ : Entity_Id;
  | 
      
      
         | 385 | 
          | 
          | 
               Source_Typ : Entity_Id := Empty);
  | 
      
      
         | 386 | 
          | 
          | 
            --  Tries to determine statically whether the two array types source type
  | 
      
      
         | 387 | 
          | 
          | 
            --  and Target_Typ have the same length. If it can be determined at compile
  | 
      
      
         | 388 | 
          | 
          | 
            --  time that they do not, then an N_Raise_Constraint_Error node replaces
  | 
      
      
         | 389 | 
          | 
          | 
            --  Expr, and a warning message is issued.
  | 
      
      
         | 390 | 
          | 
          | 
          
  | 
      
      
         | 391 | 
          | 
          | 
            procedure Apply_Scalar_Range_Check
  | 
      
      
         | 392 | 
          | 
          | 
              (Expr       : Node_Id;
  | 
      
      
         | 393 | 
          | 
          | 
               Target_Typ : Entity_Id;
  | 
      
      
         | 394 | 
          | 
          | 
               Source_Typ : Entity_Id := Empty;
  | 
      
      
         | 395 | 
          | 
          | 
               Fixed_Int  : Boolean   := False);
  | 
      
      
         | 396 | 
          | 
          | 
            --  For scalar types, determines whether an expression node should be
  | 
      
      
         | 397 | 
          | 
          | 
            --  flagged as needing a runtime range check. If the node requires such a
  | 
      
      
         | 398 | 
          | 
          | 
            --  check, the Do_Range_Check flag is turned on. The Fixed_Int flag if set
  | 
      
      
         | 399 | 
          | 
          | 
            --  causes any fixed-point values to be treated as though they were discrete
  | 
      
      
         | 400 | 
          | 
          | 
            --  values (i.e. the underlying integer value is used).
  | 
      
      
         | 401 | 
          | 
          | 
          
  | 
      
      
         | 402 | 
          | 
          | 
            type Check_Result is private;
  | 
      
      
         | 403 | 
          | 
          | 
            --  Type used to return result of Get_Range_Checks call, for later use in
  | 
      
      
         | 404 | 
          | 
          | 
            --  call to Insert_Range_Checks procedure.
  | 
      
      
         | 405 | 
          | 
          | 
          
  | 
      
      
         | 406 | 
          | 
          | 
            function Get_Range_Checks
  | 
      
      
         | 407 | 
          | 
          | 
              (Ck_Node    : Node_Id;
  | 
      
      
         | 408 | 
          | 
          | 
               Target_Typ : Entity_Id;
  | 
      
      
         | 409 | 
          | 
          | 
               Source_Typ : Entity_Id := Empty;
  | 
      
      
         | 410 | 
          | 
          | 
               Warn_Node  : Node_Id   := Empty) return Check_Result;
  | 
      
      
         | 411 | 
          | 
          | 
            --  Like Apply_Range_Check, except it does not modify anything. Instead
  | 
      
      
         | 412 | 
          | 
          | 
            --  it returns an encapsulated result of the check operations for later
  | 
      
      
         | 413 | 
          | 
          | 
            --  use in a call to Insert_Range_Checks. If Warn_Node is non-empty, its
  | 
      
      
         | 414 | 
          | 
          | 
            --  Sloc is used, in the static case, for the generated warning or error.
  | 
      
      
         | 415 | 
          | 
          | 
            --  Additionally, it is used rather than Expr (or Low/High_Bound of Expr)
  | 
      
      
         | 416 | 
          | 
          | 
            --  in constructing the check.
  | 
      
      
         | 417 | 
          | 
          | 
          
  | 
      
      
         | 418 | 
          | 
          | 
            procedure Append_Range_Checks
  | 
      
      
         | 419 | 
          | 
          | 
              (Checks       : Check_Result;
  | 
      
      
         | 420 | 
          | 
          | 
               Stmts        : List_Id;
  | 
      
      
         | 421 | 
          | 
          | 
               Suppress_Typ : Entity_Id;
  | 
      
      
         | 422 | 
          | 
          | 
               Static_Sloc  : Source_Ptr;
  | 
      
      
         | 423 | 
          | 
          | 
               Flag_Node    : Node_Id);
  | 
      
      
         | 424 | 
          | 
          | 
            --  Called to append range checks as returned by a call to Get_Range_Checks.
  | 
      
      
         | 425 | 
          | 
          | 
            --  Stmts is a list to which either the dynamic check is appended or the
  | 
      
      
         | 426 | 
          | 
          | 
            --  raise Constraint_Error statement is appended (for static checks).
  | 
      
      
         | 427 | 
          | 
          | 
            --  Static_Sloc is the Sloc at which the raise CE node points, Flag_Node is
  | 
      
      
         | 428 | 
          | 
          | 
            --  used as the node at which to set the Has_Dynamic_Check flag. Checks_On
  | 
      
      
         | 429 | 
          | 
          | 
            --  is a boolean value that says if range and index checking is on or not.
  | 
      
      
         | 430 | 
          | 
          | 
          
  | 
      
      
         | 431 | 
          | 
          | 
            procedure Insert_Range_Checks
  | 
      
      
         | 432 | 
          | 
          | 
              (Checks       : Check_Result;
  | 
      
      
         | 433 | 
          | 
          | 
               Node         : Node_Id;
  | 
      
      
         | 434 | 
          | 
          | 
               Suppress_Typ : Entity_Id;
  | 
      
      
         | 435 | 
          | 
          | 
               Static_Sloc  : Source_Ptr := No_Location;
  | 
      
      
         | 436 | 
          | 
          | 
               Flag_Node    : Node_Id    := Empty;
  | 
      
      
         | 437 | 
          | 
          | 
               Do_Before    : Boolean    := False);
  | 
      
      
         | 438 | 
          | 
          | 
            --  Called to insert range checks as returned by a call to Get_Range_Checks.
  | 
      
      
         | 439 | 
          | 
          | 
            --  Node is the node after which either the dynamic check is inserted or
  | 
      
      
         | 440 | 
          | 
          | 
            --  the raise Constraint_Error statement is inserted (for static checks).
  | 
      
      
         | 441 | 
          | 
          | 
            --  Suppress_Typ is the type to check to determine if checks are suppressed.
  | 
      
      
         | 442 | 
          | 
          | 
            --  Static_Sloc, if passed, is the Sloc at which the raise CE node points,
  | 
      
      
         | 443 | 
          | 
          | 
            --  otherwise Sloc (Node) is used. The Has_Dynamic_Check flag is normally
  | 
      
      
         | 444 | 
          | 
          | 
            --  set at Node. If Flag_Node is present, then this is used instead as the
  | 
      
      
         | 445 | 
          | 
          | 
            --  node at which to set the Has_Dynamic_Check flag. Normally the check is
  | 
      
      
         | 446 | 
          | 
          | 
            --  inserted after, if Do_Before is True, the check is inserted before
  | 
      
      
         | 447 | 
          | 
          | 
            --  Node.
  | 
      
      
         | 448 | 
          | 
          | 
          
  | 
      
      
         | 449 | 
          | 
          | 
            -----------------------
  | 
      
      
         | 450 | 
          | 
          | 
            -- Expander Routines --
  | 
      
      
         | 451 | 
          | 
          | 
            -----------------------
  | 
      
      
         | 452 | 
          | 
          | 
          
  | 
      
      
         | 453 | 
          | 
          | 
            --  Some of the earlier processing for checks results in temporarily setting
  | 
      
      
         | 454 | 
          | 
          | 
            --  the Do_Range_Check flag rather than actually generating checks. Now we
  | 
      
      
         | 455 | 
          | 
          | 
            --  are moving the generation of such checks into the front end for reasons
  | 
      
      
         | 456 | 
          | 
          | 
            --  of efficiency and simplicity (there were difficulties in handling this
  | 
      
      
         | 457 | 
          | 
          | 
            --  in the back end when side effects were present in the expressions being
  | 
      
      
         | 458 | 
          | 
          | 
            --  checked).
  | 
      
      
         | 459 | 
          | 
          | 
          
  | 
      
      
         | 460 | 
          | 
          | 
            --  Probably we could eliminate the Do_Range_Check flag entirely and
  | 
      
      
         | 461 | 
          | 
          | 
            --  generate the checks earlier, but this is a delicate area and it
  | 
      
      
         | 462 | 
          | 
          | 
            --  seemed safer to implement the following routines, which are called
  | 
      
      
         | 463 | 
          | 
          | 
            --  late on in the expansion process. They check the Do_Range_Check flag
  | 
      
      
         | 464 | 
          | 
          | 
            --  and if it is set, generate the actual checks and reset the flag.
  | 
      
      
         | 465 | 
          | 
          | 
          
  | 
      
      
         | 466 | 
          | 
          | 
            procedure Generate_Range_Check
  | 
      
      
         | 467 | 
          | 
          | 
              (N           : Node_Id;
  | 
      
      
         | 468 | 
          | 
          | 
               Target_Type : Entity_Id;
  | 
      
      
         | 469 | 
          | 
          | 
               Reason      : RT_Exception_Code);
  | 
      
      
         | 470 | 
          | 
          | 
            --  This procedure is called to actually generate and insert a range check.
  | 
      
      
         | 471 | 
          | 
          | 
            --  A check is generated to ensure that the value of N lies within the range
  | 
      
      
         | 472 | 
          | 
          | 
            --  of the target type. Note that the base type of N may be different from
  | 
      
      
         | 473 | 
          | 
          | 
            --  the base type of the target type. This happens in the conversion case.
  | 
      
      
         | 474 | 
          | 
          | 
            --  The Reason parameter is the exception code to be used for the exception
  | 
      
      
         | 475 | 
          | 
          | 
            --  if raised.
  | 
      
      
         | 476 | 
          | 
          | 
            --
  | 
      
      
         | 477 | 
          | 
          | 
            --  Note on the relation of this routine to the Do_Range_Check flag. Mostly
  | 
      
      
         | 478 | 
          | 
          | 
            --  for historical reasons, we often set the Do_Range_Check flag and then
  | 
      
      
         | 479 | 
          | 
          | 
            --  later we call Generate_Range_Check if this flag is set. Most probably we
  | 
      
      
         | 480 | 
          | 
          | 
            --  could eliminate this intermediate setting of the flag (historically the
  | 
      
      
         | 481 | 
          | 
          | 
            --  back end dealt with range checks, using this flag to indicate if a check
  | 
      
      
         | 482 | 
          | 
          | 
            --  was required, then we moved checks into the front end).
  | 
      
      
         | 483 | 
          | 
          | 
          
  | 
      
      
         | 484 | 
          | 
          | 
            procedure Generate_Index_Checks (N : Node_Id);
  | 
      
      
         | 485 | 
          | 
          | 
            --  This procedure is called to generate index checks on the subscripts for
  | 
      
      
         | 486 | 
          | 
          | 
            --  the indexed component node N. Each subscript expression is examined, and
  | 
      
      
         | 487 | 
          | 
          | 
            --  if the Do_Range_Check flag is set, an appropriate index check is
  | 
      
      
         | 488 | 
          | 
          | 
            --  generated and the flag is reset.
  | 
      
      
         | 489 | 
          | 
          | 
          
  | 
      
      
         | 490 | 
          | 
          | 
            --  Similarly, we set the flag Do_Discriminant_Check in the semantic
  | 
      
      
         | 491 | 
          | 
          | 
            --  analysis to indicate that a discriminant check is required for selected
  | 
      
      
         | 492 | 
          | 
          | 
            --  component of a discriminated type. The following routine is called from
  | 
      
      
         | 493 | 
          | 
          | 
            --  the expander to actually generate the call.
  | 
      
      
         | 494 | 
          | 
          | 
          
  | 
      
      
         | 495 | 
          | 
          | 
            procedure Generate_Discriminant_Check (N : Node_Id);
  | 
      
      
         | 496 | 
          | 
          | 
            --  N is a selected component for which a discriminant check is required to
  | 
      
      
         | 497 | 
          | 
          | 
            --  make sure that the discriminants have appropriate values for the
  | 
      
      
         | 498 | 
          | 
          | 
            --  selection. This is done by calling the appropriate discriminant checking
  | 
      
      
         | 499 | 
          | 
          | 
            --  routine for the selector.
  | 
      
      
         | 500 | 
          | 
          | 
          
  | 
      
      
         | 501 | 
          | 
          | 
            -----------------------
  | 
      
      
         | 502 | 
          | 
          | 
            -- Validity Checking --
  | 
      
      
         | 503 | 
          | 
          | 
            -----------------------
  | 
      
      
         | 504 | 
          | 
          | 
          
  | 
      
      
         | 505 | 
          | 
          | 
            --  In (RM 13.9.1(9-11)) we have the following rules on invalid values
  | 
      
      
         | 506 | 
          | 
          | 
          
  | 
      
      
         | 507 | 
          | 
          | 
            --    If the representation of a scalar object does not represent value of
  | 
      
      
         | 508 | 
          | 
          | 
            --    the object's subtype (perhaps because the object was not initialized),
  | 
      
      
         | 509 | 
          | 
          | 
            --    the object is said to have an invalid representation. It is a bounded
  | 
      
      
         | 510 | 
          | 
          | 
            --    error to evaluate the value of such an object. If the error is
  | 
      
      
         | 511 | 
          | 
          | 
            --    detected, either Constraint_Error or Program_Error is raised.
  | 
      
      
         | 512 | 
          | 
          | 
            --    Otherwise, execution continues using the invalid representation. The
  | 
      
      
         | 513 | 
          | 
          | 
            --    rules of the language outside this subclause assume that all objects
  | 
      
      
         | 514 | 
          | 
          | 
            --    have valid representations. The semantics of operations on invalid
  | 
      
      
         | 515 | 
          | 
          | 
            --    representations are as follows:
  | 
      
      
         | 516 | 
          | 
          | 
            --
  | 
      
      
         | 517 | 
          | 
          | 
            --       10  If the representation of the object represents a value of the
  | 
      
      
         | 518 | 
          | 
          | 
            --           object's type, the value of the type is used.
  | 
      
      
         | 519 | 
          | 
          | 
            --
  | 
      
      
         | 520 | 
          | 
          | 
            --       11  If the representation of the object does not represent a value
  | 
      
      
         | 521 | 
          | 
          | 
            --           of the object's type, the semantics of operations on such
  | 
      
      
         | 522 | 
          | 
          | 
            --           representations is implementation-defined, but does not by
  | 
      
      
         | 523 | 
          | 
          | 
            --           itself lead to erroneous or unpredictable execution, or to
  | 
      
      
         | 524 | 
          | 
          | 
            --           other objects becoming abnormal.
  | 
      
      
         | 525 | 
          | 
          | 
          
  | 
      
      
         | 526 | 
          | 
          | 
            --  We quote the rules in full here since they are quite delicate. Most
  | 
      
      
         | 527 | 
          | 
          | 
            --  of the time, we can just compute away with wrong values, and get a
  | 
      
      
         | 528 | 
          | 
          | 
            --  possibly wrong result, which is well within the range of allowed
  | 
      
      
         | 529 | 
          | 
          | 
            --  implementation defined behavior. The two tricky cases are subscripted
  | 
      
      
         | 530 | 
          | 
          | 
            --  array assignments, where we don't want to do wild stores, and case
  | 
      
      
         | 531 | 
          | 
          | 
            --  statements where we don't want to do wild jumps.
  | 
      
      
         | 532 | 
          | 
          | 
          
  | 
      
      
         | 533 | 
          | 
          | 
            --  In GNAT, we control validity checking with a switch -gnatV that can take
  | 
      
      
         | 534 | 
          | 
          | 
            --  three parameters, n/d/f for None/Default/Full. These modes have the
  | 
      
      
         | 535 | 
          | 
          | 
            --  following meanings:
  | 
      
      
         | 536 | 
          | 
          | 
          
  | 
      
      
         | 537 | 
          | 
          | 
            --    None (no validity checking)
  | 
      
      
         | 538 | 
          | 
          | 
          
  | 
      
      
         | 539 | 
          | 
          | 
            --      In this mode, there is no specific checking for invalid values
  | 
      
      
         | 540 | 
          | 
          | 
            --      and the code generator assumes that all stored values are always
  | 
      
      
         | 541 | 
          | 
          | 
            --      within the bounds of the object subtype. The consequences are as
  | 
      
      
         | 542 | 
          | 
          | 
            --      follows:
  | 
      
      
         | 543 | 
          | 
          | 
          
  | 
      
      
         | 544 | 
          | 
          | 
            --        For case statements, an out of range invalid value will cause
  | 
      
      
         | 545 | 
          | 
          | 
            --        Constraint_Error to be raised, or an arbitrary one of the case
  | 
      
      
         | 546 | 
          | 
          | 
            --        alternatives will be executed. Wild jumps cannot result even
  | 
      
      
         | 547 | 
          | 
          | 
            --        in this mode, since we always do a range check
  | 
      
      
         | 548 | 
          | 
          | 
          
  | 
      
      
         | 549 | 
          | 
          | 
            --        For subscripted array assignments, wild stores will result in
  | 
      
      
         | 550 | 
          | 
          | 
            --        the expected manner when addresses are calculated using values
  | 
      
      
         | 551 | 
          | 
          | 
            --        of subscripts that are out of range.
  | 
      
      
         | 552 | 
          | 
          | 
          
  | 
      
      
         | 553 | 
          | 
          | 
            --      It could perhaps be argued that this mode is still conformant with
  | 
      
      
         | 554 | 
          | 
          | 
            --      the letter of the RM, since implementation defined is a rather
  | 
      
      
         | 555 | 
          | 
          | 
            --      broad category, but certainly it is not in the spirit of the
  | 
      
      
         | 556 | 
          | 
          | 
            --      RM requirement, since wild stores certainly seem to be a case of
  | 
      
      
         | 557 | 
          | 
          | 
            --      erroneous behavior.
  | 
      
      
         | 558 | 
          | 
          | 
          
  | 
      
      
         | 559 | 
          | 
          | 
            --    Default (default standard RM-compatible validity checking)
  | 
      
      
         | 560 | 
          | 
          | 
          
  | 
      
      
         | 561 | 
          | 
          | 
            --      In this mode, which is the default, minimal validity checking is
  | 
      
      
         | 562 | 
          | 
          | 
            --      performed to ensure no erroneous behavior as follows:
  | 
      
      
         | 563 | 
          | 
          | 
          
  | 
      
      
         | 564 | 
          | 
          | 
            --        For case statements, an out of range invalid value will cause
  | 
      
      
         | 565 | 
          | 
          | 
            --        Constraint_Error to be raised.
  | 
      
      
         | 566 | 
          | 
          | 
          
  | 
      
      
         | 567 | 
          | 
          | 
            --        For subscripted array assignments, invalid out of range
  | 
      
      
         | 568 | 
          | 
          | 
            --        subscript values will cause Constraint_Error to be raised.
  | 
      
      
         | 569 | 
          | 
          | 
          
  | 
      
      
         | 570 | 
          | 
          | 
            --    Full (Full validity checking)
  | 
      
      
         | 571 | 
          | 
          | 
          
  | 
      
      
         | 572 | 
          | 
          | 
            --      In this mode, the protections guaranteed by the standard mode are
  | 
      
      
         | 573 | 
          | 
          | 
            --      in place, and the following additional checks are made:
  | 
      
      
         | 574 | 
          | 
          | 
          
  | 
      
      
         | 575 | 
          | 
          | 
            --        For every assignment, the right side is checked for validity
  | 
      
      
         | 576 | 
          | 
          | 
          
  | 
      
      
         | 577 | 
          | 
          | 
            --        For every call, IN and IN OUT parameters are checked for validity
  | 
      
      
         | 578 | 
          | 
          | 
          
  | 
      
      
         | 579 | 
          | 
          | 
            --        For every subscripted array reference, both for stores and loads,
  | 
      
      
         | 580 | 
          | 
          | 
            --        all subscripts are checked for validity.
  | 
      
      
         | 581 | 
          | 
          | 
          
  | 
      
      
         | 582 | 
          | 
          | 
            --      These checks are not required by the RM, but will in practice
  | 
      
      
         | 583 | 
          | 
          | 
            --      improve the detection of uninitialized variables, particularly
  | 
      
      
         | 584 | 
          | 
          | 
            --      if used in conjunction with pragma Normalize_Scalars.
  | 
      
      
         | 585 | 
          | 
          | 
          
  | 
      
      
         | 586 | 
          | 
          | 
            --  In the above description, we talk about performing validity checks,
  | 
      
      
         | 587 | 
          | 
          | 
            --  but we don't actually generate a check in a case where the compiler
  | 
      
      
         | 588 | 
          | 
          | 
            --  can be sure that the value is valid. Note that this assurance must
  | 
      
      
         | 589 | 
          | 
          | 
            --  be achieved without assuming that any uninitialized value lies within
  | 
      
      
         | 590 | 
          | 
          | 
            --  the range of its type. The following are cases in which values are
  | 
      
      
         | 591 | 
          | 
          | 
            --  known to be valid. The flag Is_Known_Valid is used to keep track of
  | 
      
      
         | 592 | 
          | 
          | 
            --  some of these cases.
  | 
      
      
         | 593 | 
          | 
          | 
          
  | 
      
      
         | 594 | 
          | 
          | 
            --    If all possible stored values are valid, then any uninitialized
  | 
      
      
         | 595 | 
          | 
          | 
            --    value must be valid.
  | 
      
      
         | 596 | 
          | 
          | 
          
  | 
      
      
         | 597 | 
          | 
          | 
            --    Literals, including enumeration literals, are clearly always valid
  | 
      
      
         | 598 | 
          | 
          | 
          
  | 
      
      
         | 599 | 
          | 
          | 
            --    Constants are always assumed valid, with a validity check being
  | 
      
      
         | 600 | 
          | 
          | 
            --    performed on the initializing value where necessary to ensure that
  | 
      
      
         | 601 | 
          | 
          | 
            --    this is the case.
  | 
      
      
         | 602 | 
          | 
          | 
          
  | 
      
      
         | 603 | 
          | 
          | 
            --    For variables, the status is set to known valid if there is an
  | 
      
      
         | 604 | 
          | 
          | 
            --    initializing expression. Again a check is made on the initializing
  | 
      
      
         | 605 | 
          | 
          | 
            --    value if necessary to ensure that this assumption is valid. The
  | 
      
      
         | 606 | 
          | 
          | 
            --    status can change as a result of local assignments to a variable.
  | 
      
      
         | 607 | 
          | 
          | 
            --    If a known valid value is unconditionally assigned, then we mark
  | 
      
      
         | 608 | 
          | 
          | 
            --    the left side as known valid. If a value is assigned that is not
  | 
      
      
         | 609 | 
          | 
          | 
            --    known to be valid, then we mark the left side as invalid. This
  | 
      
      
         | 610 | 
          | 
          | 
            --    kind of processing does NOT apply to non-local variables since we
  | 
      
      
         | 611 | 
          | 
          | 
            --    are not following the flow graph (more properly the flow of actual
  | 
      
      
         | 612 | 
          | 
          | 
            --    processing only corresponds to the flow graph for local assignments).
  | 
      
      
         | 613 | 
          | 
          | 
            --    For non-local variables, we preserve the current setting, i.e. a
  | 
      
      
         | 614 | 
          | 
          | 
            --    validity check is performed when assigning to a knonwn valid global.
  | 
      
      
         | 615 | 
          | 
          | 
          
  | 
      
      
         | 616 | 
          | 
          | 
            --  Note: no validity checking is required if range checks are suppressed
  | 
      
      
         | 617 | 
          | 
          | 
            --  regardless of the setting of the validity checking mode.
  | 
      
      
         | 618 | 
          | 
          | 
          
  | 
      
      
         | 619 | 
          | 
          | 
            --  The following procedures are used in handling validity checking
  | 
      
      
         | 620 | 
          | 
          | 
          
  | 
      
      
         | 621 | 
          | 
          | 
            procedure Apply_Subscript_Validity_Checks (Expr : Node_Id);
  | 
      
      
         | 622 | 
          | 
          | 
            --  Expr is the node for an indexed component. If validity checking and
  | 
      
      
         | 623 | 
          | 
          | 
            --  range checking are enabled, all subscripts for this indexed component
  | 
      
      
         | 624 | 
          | 
          | 
            --  are checked for validity.
  | 
      
      
         | 625 | 
          | 
          | 
          
  | 
      
      
         | 626 | 
          | 
          | 
            procedure Check_Valid_Lvalue_Subscripts (Expr : Node_Id);
  | 
      
      
         | 627 | 
          | 
          | 
            --  Expr is a lvalue, i.e. an expression representing the target of an
  | 
      
      
         | 628 | 
          | 
          | 
            --  assignment. This procedure checks for this expression involving an
  | 
      
      
         | 629 | 
          | 
          | 
            --  assignment to an array value. We have to be sure that all the subscripts
  | 
      
      
         | 630 | 
          | 
          | 
            --  in such a case are valid, since according to the rules in (RM
  | 
      
      
         | 631 | 
          | 
          | 
            --  13.9.1(9-11)) such assignments are not permitted to result in erroneous
  | 
      
      
         | 632 | 
          | 
          | 
            --  behavior in the case of invalid subscript values.
  | 
      
      
         | 633 | 
          | 
          | 
          
  | 
      
      
         | 634 | 
          | 
          | 
            procedure Ensure_Valid (Expr : Node_Id; Holes_OK : Boolean := False);
  | 
      
      
         | 635 | 
          | 
          | 
            --  Ensure that Expr represents a valid value of its type. If this type
  | 
      
      
         | 636 | 
          | 
          | 
            --  is not a scalar type, then the call has no effect, since validity
  | 
      
      
         | 637 | 
          | 
          | 
            --  is only an issue for scalar types. The effect of this call is to
  | 
      
      
         | 638 | 
          | 
          | 
            --  check if the value is known valid, if so, nothing needs to be done.
  | 
      
      
         | 639 | 
          | 
          | 
            --  If this is not known, then either Expr is set to be range checked,
  | 
      
      
         | 640 | 
          | 
          | 
            --  or specific checking code is inserted so that an exception is raised
  | 
      
      
         | 641 | 
          | 
          | 
            --  if the value is not valid.
  | 
      
      
         | 642 | 
          | 
          | 
            --
  | 
      
      
         | 643 | 
          | 
          | 
            --  The optional argument Holes_OK indicates whether it is necessary to
  | 
      
      
         | 644 | 
          | 
          | 
            --  worry about enumeration types with non-standard representations leading
  | 
      
      
         | 645 | 
          | 
          | 
            --  to "holes" in the range of possible representations. If Holes_OK is
  | 
      
      
         | 646 | 
          | 
          | 
            --  True, then such values are assumed valid (this is used when the caller
  | 
      
      
         | 647 | 
          | 
          | 
            --  will make a separate check for this case anyway). If Holes_OK is False,
  | 
      
      
         | 648 | 
          | 
          | 
            --  then this case is checked, and code is inserted to ensure that Expr is
  | 
      
      
         | 649 | 
          | 
          | 
            --  valid, raising Constraint_Error if the value is not valid.
  | 
      
      
         | 650 | 
          | 
          | 
          
  | 
      
      
         | 651 | 
          | 
          | 
            function Expr_Known_Valid (Expr : Node_Id) return Boolean;
  | 
      
      
         | 652 | 
          | 
          | 
            --  This function tests it the value of Expr is known to be valid in the
  | 
      
      
         | 653 | 
          | 
          | 
            --  sense of RM 13.9.1(9-11). In the case of GNAT, it is only discrete types
  | 
      
      
         | 654 | 
          | 
          | 
            --  which are a concern, since for non-discrete types we simply continue
  | 
      
      
         | 655 | 
          | 
          | 
            --  computation with invalid values, which does not lead to erroneous
  | 
      
      
         | 656 | 
          | 
          | 
            --  behavior. Thus Expr_Known_Valid always returns True if the type of Expr
  | 
      
      
         | 657 | 
          | 
          | 
            --  is non-discrete. For discrete types the value returned is True only if
  | 
      
      
         | 658 | 
          | 
          | 
            --  it can be determined that the value is Valid. Otherwise False is
  | 
      
      
         | 659 | 
          | 
          | 
            --  returned.
  | 
      
      
         | 660 | 
          | 
          | 
          
  | 
      
      
         | 661 | 
          | 
          | 
            procedure Insert_Valid_Check (Expr : Node_Id);
  | 
      
      
         | 662 | 
          | 
          | 
            --  Inserts code that will check for the value of Expr being valid, in
  | 
      
      
         | 663 | 
          | 
          | 
            --  the sense of the 'Valid attribute returning True. Constraint_Error
  | 
      
      
         | 664 | 
          | 
          | 
            --  will be raised if the value is not valid.
  | 
      
      
         | 665 | 
          | 
          | 
          
  | 
      
      
         | 666 | 
          | 
          | 
            procedure Null_Exclusion_Static_Checks (N : Node_Id);
  | 
      
      
         | 667 | 
          | 
          | 
            --  Ada 2005 (AI-231): Check bad usages of the null-exclusion issue
  | 
      
      
         | 668 | 
          | 
          | 
          
  | 
      
      
         | 669 | 
          | 
          | 
            procedure Remove_Checks (Expr : Node_Id);
  | 
      
      
         | 670 | 
          | 
          | 
            --  Remove all checks from Expr except those that are only executed
  | 
      
      
         | 671 | 
          | 
          | 
            --  conditionally (on the right side of And Then/Or Else. This call
  | 
      
      
         | 672 | 
          | 
          | 
            --  removes only embedded checks (Do_Range_Check, Do_Overflow_Check).
  | 
      
      
         | 673 | 
          | 
          | 
          
  | 
      
      
         | 674 | 
          | 
          | 
            procedure Validity_Check_Range (N : Node_Id);
  | 
      
      
         | 675 | 
          | 
          | 
            --  If N is an N_Range node, then Ensure_Valid is called on its bounds,
  | 
      
      
         | 676 | 
          | 
          | 
            --  if validity checking of operands is enabled.
  | 
      
      
         | 677 | 
          | 
          | 
          
  | 
      
      
         | 678 | 
          | 
          | 
            -----------------------------
  | 
      
      
         | 679 | 
          | 
          | 
            -- Handling of Check Names --
  | 
      
      
         | 680 | 
          | 
          | 
            -----------------------------
  | 
      
      
         | 681 | 
          | 
          | 
          
  | 
      
      
         | 682 | 
          | 
          | 
            --  The following table contains Name_Id's for recognized checks. The first
  | 
      
      
         | 683 | 
          | 
          | 
            --  entries (corresponding to the values of the subtype Predefined_Check_Id)
  | 
      
      
         | 684 | 
          | 
          | 
            --  contain the Name_Id values for the checks that are predefined, including
  | 
      
      
         | 685 | 
          | 
          | 
            --  All_Checks (see Types). Remaining entries are those that are introduced
  | 
      
      
         | 686 | 
          | 
          | 
            --  by pragma Check_Names.
  | 
      
      
         | 687 | 
          | 
          | 
          
  | 
      
      
         | 688 | 
          | 
          | 
            package Check_Names is new Table.Table (
  | 
      
      
         | 689 | 
          | 
          | 
              Table_Component_Type => Name_Id,
  | 
      
      
         | 690 | 
          | 
          | 
              Table_Index_Type     => Check_Id,
  | 
      
      
         | 691 | 
          | 
          | 
              Table_Low_Bound      => 1,
  | 
      
      
         | 692 | 
          | 
          | 
              Table_Initial        => 30,
  | 
      
      
         | 693 | 
          | 
          | 
              Table_Increment      => 200,
  | 
      
      
         | 694 | 
          | 
          | 
              Table_Name           => "Name_Check_Names");
  | 
      
      
         | 695 | 
          | 
          | 
          
  | 
      
      
         | 696 | 
          | 
          | 
            function Get_Check_Id (N : Name_Id) return Check_Id;
  | 
      
      
         | 697 | 
          | 
          | 
            --  Function to search above table for matching name. If found returns the
  | 
      
      
         | 698 | 
          | 
          | 
            --  corresponding Check_Id value in the range 1 .. Check_Name.Last. If not
  | 
      
      
         | 699 | 
          | 
          | 
            --  found returns No_Check_Id.
  | 
      
      
         | 700 | 
          | 
          | 
          
  | 
      
      
         | 701 | 
          | 
          | 
         private
  | 
      
      
         | 702 | 
          | 
          | 
          
  | 
      
      
         | 703 | 
          | 
          | 
            type Check_Result is array (Positive range 1 .. 2) of Node_Id;
  | 
      
      
         | 704 | 
          | 
          | 
            --  There are two cases for the result returned by Range_Check:
  | 
      
      
         | 705 | 
          | 
          | 
            --
  | 
      
      
         | 706 | 
          | 
          | 
            --    For the static case the result is one or two nodes that should cause
  | 
      
      
         | 707 | 
          | 
          | 
            --    a Constraint_Error. Typically these will include Expr itself or the
  | 
      
      
         | 708 | 
          | 
          | 
            --    direct descendents of Expr, such as Low/High_Bound (Expr)). It is the
  | 
      
      
         | 709 | 
          | 
          | 
            --    responsibility of the caller to rewrite and substitute the nodes with
  | 
      
      
         | 710 | 
          | 
          | 
            --    N_Raise_Constraint_Error nodes.
  | 
      
      
         | 711 | 
          | 
          | 
            --
  | 
      
      
         | 712 | 
          | 
          | 
            --    For the non-static case a single N_Raise_Constraint_Error node with a
  | 
      
      
         | 713 | 
          | 
          | 
            --    non-empty Condition field is returned.
  | 
      
      
         | 714 | 
          | 
          | 
            --
  | 
      
      
         | 715 | 
          | 
          | 
            --  Unused entries in Check_Result, if any, are simply set to Empty For
  | 
      
      
         | 716 | 
          | 
          | 
            --  external clients, the required processing on this result is achieved
  | 
      
      
         | 717 | 
          | 
          | 
            --  using the Insert_Range_Checks routine.
  | 
      
      
         | 718 | 
          | 
          | 
          
  | 
      
      
         | 719 | 
          | 
          | 
            pragma Inline (Apply_Length_Check);
  | 
      
      
         | 720 | 
          | 
          | 
            pragma Inline (Apply_Range_Check);
  | 
      
      
         | 721 | 
          | 
          | 
            pragma Inline (Apply_Static_Length_Check);
  | 
      
      
         | 722 | 
          | 
          | 
         end Checks;
  |