-- routine is to find the real type by looking up the tree. We also
-- determine if the operation must be rounded.
+ procedure Get_First_Index_Bounds (T : Entity_Id; Lo, Hi : out Uint);
+ -- T is an array whose index bounds are all known at compile time. Return
+ -- the value of the low and high bounds of the first index of T.
+
function Get_Size_For_Range (Lo, Hi : Uint) return Uint;
-- Return the size of a small signed integer type covering Lo .. Hi, the
-- main goal being to return a size lower than that of standard types.
if Ekind (Otyp) = E_String_Literal_Subtype then
return String_Literal_Length (Otyp) < 4;
- else
+ elsif Compile_Time_Known_Bounds (Otyp) then
declare
- Ityp : constant Entity_Id := Etype (First_Index (Otyp));
- Lo : constant Node_Id := Type_Low_Bound (Ityp);
- Hi : constant Node_Id := Type_High_Bound (Ityp);
- Lov : Uint;
- Hiv : Uint;
+ Lo, Hi : Uint;
begin
- if Compile_Time_Known_Value (Lo) then
- Lov := Expr_Value (Lo);
- else
- return False;
- end if;
-
- if Compile_Time_Known_Value (Hi) then
- Hiv := Expr_Value (Hi);
- else
- return False;
- end if;
-
- return Hiv < Lov + 3;
+ Get_First_Index_Bounds (Otyp, Lo, Hi);
+ return Hi < Lo + 3;
end;
+
+ else
+ return False;
end if;
end Length_Less_Than_4;
-- this loop is complete, always contains the last operand (which is not
-- the same as Operands (NN), since null operands are skipped).
+ Too_Large_Max_Length : constant Unat := UI_From_Int (256);
+ -- Threshold from which the computation of maximum lengths is useless
+
-- Arrays describing the operands, only the first NN entries of each
-- array are set (NN < N when we exclude known null operands).
-- Set to the corresponding entry in the Opnds list (but note that null
-- operands are excluded, so not all entries in the list are stored).
- Fixed_Length : array (1 .. N) of Uint;
+ Fixed_Length : array (1 .. N) of Unat;
-- Set to length of operand. Entries in this array are set only if the
-- corresponding entry in Is_Fixed_Length is True.
+ Max_Length : array (1 .. N) of Unat;
+ -- Set to the maximum length of operand, or Too_Large_Max_Length if it
+ -- is not known. Entries in this array are set only if the corresponding
+ -- entry in Is_Fixed_Length is False;
+
Opnd_Low_Bound : array (1 .. N) of Node_Id;
-- Set to lower bound of operand. Either an integer literal in the case
-- where the bound is known at compile time, else actual lower bound.
-- is False. The entity is of type Artyp.
Aggr_Length : array (0 .. N) of Node_Id;
- -- The J'th entry in an expression node that represents the total length
+ -- The J'th entry is an expression node that represents the total length
-- of operands 1 through J. It is either an integer literal node, or a
-- reference to a constant entity with the right value, so it is fine
-- to just do a Copy_Node to get an appropriate copy. The extra zeroth
-- entry always is set to zero. The length is of type Artyp.
+ Max_Aggr_Length : Unat := Too_Large_Max_Length;
+ -- Set to the maximum total length, or at least Too_Large_Max_Length if
+ -- it is not known.
+
Low_Bound : Node_Id := Empty;
-- A tree node representing the low bound of the result (of type Ityp).
-- This is either an integer literal node, or an identifier reference to
-- a constant entity initialized to the appropriate value.
+ High_Bound : Node_Id := Empty;
+ -- A tree node representing the high bound of the result (of type Ityp)
+
Last_Opnd_Low_Bound : Node_Id := Empty;
-- A tree node representing the low bound of the last operand. This
-- need only be set if the result could be null. It is used for the
-- special case of setting the right high bound for a null result.
-- This is of type Ityp.
- High_Bound : Node_Id := Empty;
- -- A tree node representing the high bound of the result (of type Ityp)
-
Result : Node_Id := Empty;
-- Result of the concatenation (of type Ityp)
-- Return True if the concatenation is within the expression of the
-- declaration of a library-level object.
- function Make_Artyp_Literal (Val : Nat) return Node_Id;
+ function Make_Artyp_Literal (Val : Uint) return Node_Id;
-- This function makes an N_Integer_Literal node that is returned in
-- analyzed form with the type set to Artyp. Importantly this literal
-- is not flagged as static, so that if we do computations with it that
-- Make_Artyp_Literal --
------------------------
- function Make_Artyp_Literal (Val : Nat) return Node_Id is
+ function Make_Artyp_Literal (Val : Uint) return Node_Id is
Result : constant Node_Id := Make_Integer_Literal (Loc, Val);
begin
Set_Etype (Result, Artyp);
-- Local Declarations
Opnd_Typ : Entity_Id;
+ Slice_Rng : Entity_Id;
Subtyp_Ind : Entity_Id;
Ent : Entity_Id;
- Len : Uint;
+ Len : Unat;
J : Nat;
Clen : Node_Id;
Set : Boolean;
-- Supply dummy entry at start of length array
- Aggr_Length (0) := Make_Artyp_Literal (0);
+ Aggr_Length (0) := Make_Artyp_Literal (Uint_0);
-- Go through operands setting up the above arrays
elsif Nkind (Opnd) = N_String_Literal then
Len := String_Literal_Length (Opnd_Typ);
- if Len /= 0 then
+ if Len > 0 then
Result_May_Be_Null := False;
end if;
else
-- Check constrained case with known bounds
- if Is_Constrained (Opnd_Typ) then
+ if Is_Constrained (Opnd_Typ)
+ and then Compile_Time_Known_Bounds (Opnd_Typ)
+ then
declare
- Index : constant Node_Id := First_Index (Opnd_Typ);
- Indx_Typ : constant Entity_Id := Etype (Index);
- Lo : constant Node_Id := Type_Low_Bound (Indx_Typ);
- Hi : constant Node_Id := Type_High_Bound (Indx_Typ);
+ Lo, Hi : Uint;
begin
-- Fixed length constrained array type with known at compile
-- time bounds is last case of fixed length operand.
- if Compile_Time_Known_Value (Lo)
- and then
- Compile_Time_Known_Value (Hi)
- then
- declare
- Loval : constant Uint := Expr_Value (Lo);
- Hival : constant Uint := Expr_Value (Hi);
- Len : constant Uint :=
- UI_Max (Hival - Loval + 1, Uint_0);
+ Get_First_Index_Bounds (Opnd_Typ, Lo, Hi);
+ Len := UI_Max (Hi - Lo + 1, Uint_0);
- begin
- if Len > 0 then
- Result_May_Be_Null := False;
- end if;
+ if Len > 0 then
+ Result_May_Be_Null := False;
+ end if;
- -- Capture last operand bounds if result could be null
+ -- Capture last operand bounds if result could be null
- if J = N and then Result_May_Be_Null then
- Last_Opnd_Low_Bound :=
- Convert_To (Ityp,
- Make_Integer_Literal (Loc, Expr_Value (Lo)));
+ if J = N and then Result_May_Be_Null then
+ Last_Opnd_Low_Bound :=
+ To_Ityp (Make_Integer_Literal (Loc, Lo));
- Last_Opnd_High_Bound :=
- Convert_To (Ityp,
- Make_Integer_Literal (Loc, Expr_Value (Hi)));
- end if;
+ Last_Opnd_High_Bound :=
+ To_Ityp (Make_Integer_Literal (Loc, Hi));
+ end if;
- -- Exclude null length case unless last operand
+ -- Exclude null length case unless last operand
- if J < N and then Len = 0 then
- goto Continue;
- end if;
+ if J < N and then Len = 0 then
+ goto Continue;
+ end if;
- NN := NN + 1;
- Operands (NN) := Opnd;
- Is_Fixed_Length (NN) := True;
- Fixed_Length (NN) := Len;
+ NN := NN + 1;
+ Operands (NN) := Opnd;
+ Is_Fixed_Length (NN) := True;
+ Fixed_Length (NN) := Len;
- Opnd_Low_Bound (NN) :=
- To_Ityp
- (Make_Integer_Literal (Loc, Expr_Value (Lo)));
- Set := True;
- end;
- end if;
+ Opnd_Low_Bound (NN) :=
+ To_Ityp (Make_Integer_Literal (Loc, Lo));
+ Set := True;
end;
end if;
Var_Length (NN) := Make_Temporary (Loc, 'L');
+ -- If the operand is a slice, try to compute an upper bound for
+ -- its length.
+
+ if Nkind (Opnd) = N_Slice
+ and then Is_Constrained (Etype (Prefix (Opnd)))
+ and then Compile_Time_Known_Bounds (Etype (Prefix (Opnd)))
+ then
+ declare
+ Lo, Hi : Uint;
+
+ begin
+ Get_First_Index_Bounds (Etype (Prefix (Opnd)), Lo, Hi);
+ Max_Length (NN) := UI_Max (Hi - Lo + 1, Uint_0);
+ end;
+
+ else
+ Max_Length (NN) := Too_Large_Max_Length;
+ end if;
+
Append_To (Actions,
Make_Object_Declaration (Loc,
Defining_Identifier => Var_Length (NN),
if NN = 1 then
if Is_Fixed_Length (1) then
Aggr_Length (1) := Make_Integer_Literal (Loc, Fixed_Length (1));
+ Max_Aggr_Length := Fixed_Length (1);
else
Aggr_Length (1) := New_Occurrence_Of (Var_Length (1), Loc);
+ Max_Aggr_Length := Max_Length (1);
end if;
-- If entry is fixed length and only fixed lengths so far, make
Aggr_Length (NN) :=
Make_Integer_Literal (Loc,
Intval => Fixed_Length (NN) + Intval (Aggr_Length (NN - 1)));
+ Max_Aggr_Length := Intval (Aggr_Length (NN));
-- All other cases, construct an addition node for the length and
-- create an entity initialized to this length.
if Is_Fixed_Length (NN) then
Clen := Make_Integer_Literal (Loc, Fixed_Length (NN));
+ Max_Aggr_Length := Max_Aggr_Length + Fixed_Length (NN);
+
else
Clen := New_Occurrence_Of (Var_Length (NN), Loc);
+ Max_Aggr_Length := Max_Aggr_Length + Max_Length (NN);
end if;
Append_To (Actions,
pragma Assert (Present (Low_Bound));
- -- Now we can safely compute the upper bound, normally
- -- Low_Bound + Length - 1.
-
- High_Bound :=
- To_Ityp
- (Make_Op_Add (Loc,
- Left_Opnd => To_Artyp (New_Copy_Tree (Low_Bound)),
- Right_Opnd =>
- Make_Op_Subtract (Loc,
- Left_Opnd => New_Copy_Tree (Aggr_Length (NN)),
- Right_Opnd => Make_Artyp_Literal (1))));
-
- -- Note that calculation of the high bound may cause overflow in some
- -- very weird cases, so in the general case we need an overflow check on
- -- the high bound. We can avoid this for the common case of string types
- -- and other types whose index is Positive, since we chose a wider range
- -- for the arithmetic type. If checks are suppressed we do not set the
- -- flag, and possibly superfluous warnings will be omitted.
+ -- Now we can compute the high bound as Low_Bound + Length - 1
- if Istyp /= Standard_Positive
- and then not Overflow_Checks_Suppressed (Istyp)
+ if Compile_Time_Known_Value (Low_Bound)
+ and then Nkind (Aggr_Length (NN)) = N_Integer_Literal
then
- Activate_Overflow_Check (High_Bound);
+ High_Bound :=
+ To_Ityp
+ (Make_Artyp_Literal
+ (Expr_Value (Low_Bound) + Intval (Aggr_Length (NN)) - 1));
+
+ else
+ High_Bound :=
+ To_Ityp
+ (Make_Op_Add (Loc,
+ Left_Opnd => To_Artyp (New_Copy_Tree (Low_Bound)),
+ Right_Opnd =>
+ Make_Op_Subtract (Loc,
+ Left_Opnd => New_Copy_Tree (Aggr_Length (NN)),
+ Right_Opnd => Make_Artyp_Literal (Uint_1))));
+
+ -- Note that calculation of the high bound may cause overflow in some
+ -- very weird cases, so in the general case we need an overflow check
+ -- on the high bound. We can avoid this for the common case of string
+ -- types and other types whose index is Positive, since we chose a
+ -- wider range for the arithmetic type. If checks are suppressed, we
+ -- do not set the flag so superfluous warnings may be omitted.
+
+ if Istyp /= Standard_Positive
+ and then not Overflow_Checks_Suppressed (Istyp)
+ then
+ Activate_Overflow_Check (High_Bound);
+ end if;
end if;
-- Handle the exceptional case where the result is null, in which case
Expressions => New_List (
Make_Op_Eq (Loc,
Left_Opnd => New_Copy_Tree (Aggr_Length (NN)),
- Right_Opnd => Make_Artyp_Literal (0)),
+ Right_Opnd => Make_Artyp_Literal (Uint_0)),
Last_Opnd_Low_Bound,
Low_Bound));
Expressions => New_List (
Make_Op_Eq (Loc,
Left_Opnd => New_Copy_Tree (Aggr_Length (NN)),
- Right_Opnd => Make_Artyp_Literal (0)),
+ Right_Opnd => Make_Artyp_Literal (Uint_0)),
Last_Opnd_High_Bound,
High_Bound));
end if;
Insert_Actions (Cnode, Actions, Suppress => All_Checks);
+ -- If the low bound is known at compile time and not the high bound, but
+ -- we have computed a sensible upper bound for the length, then adjust
+ -- the high bound for the subtype of the array. This will change it into
+ -- a static subtype and thus help the code generator.
+
+ if Compile_Time_Known_Value (Low_Bound)
+ and then not Compile_Time_Known_Value (High_Bound)
+ and then Max_Aggr_Length < Too_Large_Max_Length
+ then
+ declare
+ Known_High_Bound : constant Node_Id :=
+ To_Ityp
+ (Make_Artyp_Literal
+ (Expr_Value (Low_Bound) + Max_Aggr_Length - 1));
+
+ begin
+ if not Is_Out_Of_Range (Known_High_Bound, Ityp) then
+ Slice_Rng := Make_Range (Loc, Low_Bound, High_Bound);
+ High_Bound := Known_High_Bound;
+
+ else
+ Slice_Rng := Empty;
+ end if;
+ end;
+
+ else
+ Slice_Rng := Empty;
+ end if;
+
-- Now we construct an array object with appropriate bounds. We mark
-- the target as internal to prevent useless initialization when
-- Initialize_Scalars is enabled. Also since this is the actual result
-- Catch the static out of range case now
- if Raises_Constraint_Error (High_Bound) then
+ if Raises_Constraint_Error (High_Bound)
+ or else Is_Out_Of_Range (High_Bound, Ityp)
+ then
-- Kill warning generated for the declaration of the static out of
-- range high bound, and instead generate a Constraint_Error with
-- an appropriate specific message.
- Kill_Dead_Code (Declaration_Node (Entity (High_Bound)));
+ if Nkind (High_Bound) = N_Integer_Literal then
+ Kill_Dead_Code (High_Bound);
+ Rewrite (High_Bound, New_Copy_Tree (Low_Bound));
+
+ else
+ Kill_Dead_Code (Declaration_Node (Entity (High_Bound)));
+ end if;
+
Apply_Compile_Time_Constraint_Error
(N => Cnode,
Msg => "concatenation result upper bound out of range??",
Reason => CE_Range_Check_Failed);
+
return;
end if;
Name => New_Occurrence_Of (RTE (RR (NN)), Loc),
Parameter_Associations => Opnds));
- Result := New_Occurrence_Of (Ent, Loc);
- goto Done;
+ -- No assignments left to do below
+
+ NN := 0;
end;
end if;
end;
Right_Opnd =>
Make_Op_Subtract (Loc,
Left_Opnd => Aggr_Length (J),
- Right_Opnd => Make_Artyp_Literal (1)));
+ Right_Opnd => Make_Artyp_Literal (Uint_1)));
begin
-- Singleton case, simple assignment
end;
end loop;
- -- Finally we build the result, which is a reference to the array object
+ -- Finally we build the result, which is either a direct reference to
+ -- the array object or a slice of it.
Result := New_Occurrence_Of (Ent, Loc);
+ if Present (Slice_Rng) then
+ Result := Make_Slice (Loc, Result, Slice_Rng);
+ end if;
+
<<Done>>
pragma Assert (Present (Result));
Rewrite (Cnode, Result);
end if;
end Fixup_Universal_Fixed_Operation;
+ ----------------------------
+ -- Get_First_Index_Bounds --
+ ----------------------------
+
+ procedure Get_First_Index_Bounds (T : Entity_Id; Lo, Hi : out Uint) is
+ Typ : Entity_Id;
+
+ begin
+ pragma Assert (Is_Array_Type (T));
+
+ -- This follows Sem_Eval.Compile_Time_Known_Bounds
+
+ Typ := Underlying_Type (Etype (First_Index (T)));
+
+ Lo := Expr_Value (Type_Low_Bound (Typ));
+ Hi := Expr_Value (Type_High_Bound (Typ));
+ end Get_First_Index_Bounds;
+
------------------------
-- Get_Size_For_Range --
------------------------
projects / thirdparty / gcc.git / commitdiff
