when Attribute_Pred => Pred : declare
Etyp : constant Entity_Id := Base_Type (Ptyp);
+ Ityp : Entity_Id;
begin
-
-- For enumeration types with non-standard representations, we
- -- expand typ'Pred (x) into
+ -- expand typ'Pred (x) into:
-- Pos_To_Rep (Rep_To_Pos (x) - 1)
- -- If the representation is contiguous, we compute instead
- -- Lit1 + Rep_to_Pos (x -1), to catch invalid representations.
- -- The conversion function Enum_Pos_To_Rep is defined on the
- -- base type, not the subtype, so we have to use the base type
- -- explicitly for this and other enumeration attributes.
+ -- if the representation is non-contiguous, and just x - 1 if it is
+ -- after having dealt with constraint checking.
- if Is_Enumeration_Type (Ptyp)
+ if Is_Enumeration_Type (Etyp)
and then Present (Enum_Pos_To_Rep (Etyp))
then
if Has_Contiguous_Rep (Etyp) then
- Rewrite (N,
- Unchecked_Convert_To (Ptyp,
- Make_Op_Add (Loc,
- Left_Opnd =>
- Make_Integer_Literal (Loc,
- Enumeration_Rep (First_Literal (Ptyp))),
- Right_Opnd =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of
- (TSS (Etyp, TSS_Rep_To_Pos), Loc),
+ if not Range_Checks_Suppressed (Ptyp) then
+ Set_Do_Range_Check (First (Exprs), False);
+ Expand_Pred_Succ_Attribute (N);
+ end if;
+
+ if Is_Unsigned_Type (Etyp) then
+ if Esize (Typ) <= Standard_Integer_Size then
+ Ityp := RTE (RE_Unsigned);
+ else
+ Ityp := RTE (RE_Long_Long_Unsigned);
+ end if;
- Parameter_Associations =>
- New_List (
- Unchecked_Convert_To (Ptyp,
- Make_Op_Subtract (Loc,
- Left_Opnd =>
- Unchecked_Convert_To (Standard_Integer,
- Relocate_Node (First (Exprs))),
- Right_Opnd =>
- Make_Integer_Literal (Loc, 1))),
- Rep_To_Pos_Flag (Ptyp, Loc))))));
+ else
+ if Esize (Etyp) <= Standard_Integer_Size then
+ Ityp := Standard_Integer;
+ else
+ Ityp := Standard_Long_Long_Integer;
+ end if;
+ end if;
+
+ Rewrite (N,
+ Unchecked_Convert_To (Etyp,
+ Make_Op_Subtract (Loc,
+ Left_Opnd =>
+ Unchecked_Convert_To (Ityp, First (Exprs)),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, 1))));
else
-- Add Boolean parameter True, to request program error if
Right_Opnd => Make_Integer_Literal (Loc, 1)))));
end if;
- Analyze_And_Resolve (N, Typ);
+ -- Suppress checks since they have all been done above
+
+ Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
-- For floating-point, we transform 'Pred into a call to the Pred
-- floating-point attribute function in Fat_xxx (xxx is root type).
when Attribute_Succ => Succ : declare
Etyp : constant Entity_Id := Base_Type (Ptyp);
+ Ityp : Entity_Id;
begin
-- For enumeration types with non-standard representations, we
- -- expand typ'Succ (x) into
+ -- expand typ'Pred (x) into:
-- Pos_To_Rep (Rep_To_Pos (x) + 1)
- -- If the representation is contiguous, we compute instead
- -- Lit1 + Rep_to_Pos (x+1), to catch invalid representations.
+ -- if the representation is non-contiguous, and just x + 1 if it is
+ -- after having dealt with constraint checking.
- if Is_Enumeration_Type (Ptyp)
+ if Is_Enumeration_Type (Etyp)
and then Present (Enum_Pos_To_Rep (Etyp))
then
if Has_Contiguous_Rep (Etyp) then
+ if not Range_Checks_Suppressed (Ptyp) then
+ Set_Do_Range_Check (First (Exprs), False);
+ Expand_Pred_Succ_Attribute (N);
+ end if;
+
+ if Is_Unsigned_Type (Etyp) then
+ if Esize (Typ) <= Standard_Integer_Size then
+ Ityp := RTE (RE_Unsigned);
+ else
+ Ityp := RTE (RE_Long_Long_Unsigned);
+ end if;
+
+ else
+ if Esize (Etyp) <= Standard_Integer_Size then
+ Ityp := Standard_Integer;
+ else
+ Ityp := Standard_Long_Long_Integer;
+ end if;
+ end if;
+
Rewrite (N,
- Unchecked_Convert_To (Ptyp,
- Make_Op_Add (Loc,
- Left_Opnd =>
- Make_Integer_Literal (Loc,
- Enumeration_Rep (First_Literal (Ptyp))),
- Right_Opnd =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of
- (TSS (Etyp, TSS_Rep_To_Pos), Loc),
+ Unchecked_Convert_To (Etyp,
+ Make_Op_Add (Loc,
+ Left_Opnd =>
+ Unchecked_Convert_To (Ityp, First (Exprs)),
+ Right_Opnd =>
+ Make_Integer_Literal (Loc, 1))));
- Parameter_Associations =>
- New_List (
- Unchecked_Convert_To (Ptyp,
- Make_Op_Add (Loc,
- Left_Opnd =>
- Unchecked_Convert_To (Standard_Integer,
- Relocate_Node (First (Exprs))),
- Right_Opnd =>
- Make_Integer_Literal (Loc, 1))),
- Rep_To_Pos_Flag (Ptyp, Loc))))));
else
-- Add Boolean parameter True, to request program error if
-- we have a bad representation on our hands. Add False if
Right_Opnd => Make_Integer_Literal (Loc, 1)))));
end if;
- Analyze_And_Resolve (N, Typ);
+ -- Suppress checks since they have all been done above
+
+ Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
-- For floating-point, we transform 'Succ into a call to the Succ
-- floating-point attribute function in Fat_xxx (xxx is root type)
when Attribute_Val => Val : declare
Etyp : constant Entity_Id := Base_Type (Ptyp);
Expr : constant Node_Id := First (Exprs);
+ Ityp : Entity_Id;
+ Rtyp : Entity_Id;
begin
-- Case of enumeration type
if Is_Enumeration_Type (Etyp) then
- -- Non-standard enumeration type
+ -- Non-contiguous non-standard enumeration type
- if Present (Enum_Pos_To_Rep (Etyp)) then
- if Has_Contiguous_Rep (Etyp) then
- declare
- Rep_Node : constant Node_Id :=
- Unchecked_Convert_To (Etyp,
- Make_Op_Add (Loc,
- Left_Opnd =>
- Make_Integer_Literal (Loc,
- Enumeration_Rep (First_Literal (Etyp))),
- Right_Opnd =>
- Convert_To (Standard_Integer, Expr)));
+ if Present (Enum_Pos_To_Rep (Etyp))
+ and then not Has_Contiguous_Rep (Etyp)
+ then
+ Rewrite (N,
+ Make_Indexed_Component (Loc,
+ Prefix =>
+ New_Occurrence_Of (Enum_Pos_To_Rep (Etyp), Loc),
+ Expressions => New_List (
+ Convert_To (Standard_Integer, Expr))));
- begin
- Rewrite (N,
- Unchecked_Convert_To (Etyp,
- Make_Op_Add (Loc,
- Left_Opnd =>
- Make_Integer_Literal (Loc,
- Enumeration_Rep (First_Literal (Etyp))),
- Right_Opnd =>
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of
- (TSS (Etyp, TSS_Rep_To_Pos), Loc),
- Parameter_Associations => New_List (
- Rep_Node,
- Rep_To_Pos_Flag (Etyp, Loc))))));
- end;
+ Analyze_And_Resolve (N, Typ);
- else
- Rewrite (N,
- Make_Indexed_Component (Loc,
- Prefix =>
- New_Occurrence_Of (Enum_Pos_To_Rep (Etyp), Loc),
- Expressions => New_List (
- Convert_To (Standard_Integer, Expr))));
- end if;
+ -- Standard or contiguous non-standard enumeration type
- Analyze_And_Resolve (N, Typ);
+ else
+ -- If the argument is marked as requiring a range check then
+ -- generate it here, after looking through a conversion to
+ -- universal integer, if any.
+
+ if Do_Range_Check (Expr) then
+ if Present (Enum_Pos_To_Rep (Etyp)) then
+ Rtyp := Enum_Pos_To_Rep (Etyp);
+ else
+ Rtyp := Etyp;
+ end if;
- -- Standard enumeration type
+ if Nkind (Expr) = N_Type_Conversion
+ and then Entity (Subtype_Mark (Expr)) = Universal_Integer
+ then
+ Generate_Range_Check
+ (Expression (Expr), Rtyp, CE_Range_Check_Failed);
- -- If the argument is marked as requiring a range check then
- -- generate it here, after looking through a conversion to
- -- universal integer, if any.
+ else
+ Generate_Range_Check (Expr, Rtyp, CE_Range_Check_Failed);
+ end if;
- elsif Do_Range_Check (Expr) then
- if Nkind (Expr) = N_Type_Conversion
- and then Entity (Subtype_Mark (Expr)) = Universal_Integer
- then
- Generate_Range_Check
- (Expression (Expr), Etyp, CE_Range_Check_Failed);
Set_Do_Range_Check (Expr, False);
+ end if;
- else
- Generate_Range_Check (Expr, Etyp, CE_Range_Check_Failed);
+ -- Contiguous non-standard enumeration type
+
+ if Present (Enum_Pos_To_Rep (Etyp)) then
+ if Is_Unsigned_Type (Etyp) then
+ if Esize (Typ) <= Standard_Integer_Size then
+ Ityp := RTE (RE_Unsigned);
+ else
+ Ityp := RTE (RE_Long_Long_Unsigned);
+ end if;
+
+ else
+ if Esize (Etyp) <= Standard_Integer_Size then
+ Ityp := Standard_Integer;
+ else
+ Ityp := Standard_Long_Long_Integer;
+ end if;
+ end if;
+
+ Rewrite (N,
+ Unchecked_Convert_To (Etyp,
+ Make_Op_Add (Loc,
+ Left_Opnd =>
+ Make_Integer_Literal (Loc,
+ Enumeration_Rep (First_Literal (Etyp))),
+ Right_Opnd =>
+ Convert_To (Ityp, Expr))));
+
+ -- Suppress checks since the range check was done above
+ -- and it guarantees that the addition cannot overflow.
+
+ Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
end if;
end if;
Ent : Entity_Id;
Fent : Entity_Id;
Is_Contiguous : Boolean;
+ Index_Typ : Entity_Id;
Ityp : Entity_Id;
Last_Repval : Uint;
Lst : List_Id;
Ent := First_Literal (Typ);
Last_Repval := Enumeration_Rep (Ent);
-
+ Num := 1;
Next_Literal (Ent);
+
while Present (Ent) loop
if Enumeration_Rep (Ent) - Last_Repval /= 1 then
Is_Contiguous := False;
- exit;
else
Last_Repval := Enumeration_Rep (Ent);
end if;
+ Num := Num + 1;
Next_Literal (Ent);
end loop;
if Is_Contiguous then
Set_Has_Contiguous_Rep (Typ);
- Ent := First_Literal (Typ);
- Num := 1;
- Lst := New_List (New_Occurrence_Of (Ent, Sloc (Ent)));
+
+ -- Now build a subtype declaration
+
+ -- subtype typI is new Natural range 0 .. num - 1
+
+ Index_Typ :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (Typ), 'I'));
+
+ Append_Freeze_Action (Typ,
+ Make_Subtype_Declaration (Loc,
+ Defining_Identifier => Index_Typ,
+ Subtype_Indication =>
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (Standard_Natural, Loc),
+ Constraint =>
+ Make_Range_Constraint (Loc,
+ Range_Expression =>
+ Make_Range (Loc,
+ Low_Bound =>
+ Make_Integer_Literal (Loc, 0),
+ High_Bound =>
+ Make_Integer_Literal (Loc, Num - 1))))));
+
+ Set_Enum_Pos_To_Rep (Typ, Index_Typ);
else
-- Build list of literal references
Lst := New_List;
- Num := 0;
-
Ent := First_Literal (Typ);
while Present (Ent) loop
Append_To (Lst, New_Occurrence_Of (Ent, Sloc (Ent)));
- Num := Num + 1;
Next_Literal (Ent);
end loop;
- end if;
-
- -- Now build an array declaration
- -- typA : array (Natural range 0 .. num - 1) of ctype :=
- -- (v, v, v, v, v, ....)
+ -- Now build an array declaration
- -- where ctype is the corresponding integer type. If the representation
- -- is contiguous, we only keep the first literal, which provides the
- -- offset for Pos_To_Rep computations.
+ -- typA : constant array (Natural range 0 .. num - 1) of typ :=
+ -- (v, v, v, v, v, ....)
- Arr :=
- Make_Defining_Identifier (Loc,
- Chars => New_External_Name (Chars (Typ), 'A'));
+ Arr :=
+ Make_Defining_Identifier (Loc,
+ Chars => New_External_Name (Chars (Typ), 'A'));
- Append_Freeze_Action (Typ,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Arr,
- Constant_Present => True,
-
- Object_Definition =>
- Make_Constrained_Array_Definition (Loc,
- Discrete_Subtype_Definitions => New_List (
- Make_Subtype_Indication (Loc,
- Subtype_Mark => New_Occurrence_Of (Standard_Natural, Loc),
- Constraint =>
- Make_Range_Constraint (Loc,
- Range_Expression =>
- Make_Range (Loc,
- Low_Bound =>
- Make_Integer_Literal (Loc, 0),
- High_Bound =>
- Make_Integer_Literal (Loc, Num - 1))))),
-
- Component_Definition =>
- Make_Component_Definition (Loc,
- Aliased_Present => False,
- Subtype_Indication => New_Occurrence_Of (Typ, Loc))),
+ Append_Freeze_Action (Typ,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Arr,
+ Constant_Present => True,
+
+ Object_Definition =>
+ Make_Constrained_Array_Definition (Loc,
+ Discrete_Subtype_Definitions => New_List (
+ Make_Subtype_Indication (Loc,
+ Subtype_Mark =>
+ New_Occurrence_Of (Standard_Natural, Loc),
+ Constraint =>
+ Make_Range_Constraint (Loc,
+ Range_Expression =>
+ Make_Range (Loc,
+ Low_Bound =>
+ Make_Integer_Literal (Loc, 0),
+ High_Bound =>
+ Make_Integer_Literal (Loc, Num - 1))))),
+
+ Component_Definition =>
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication => New_Occurrence_Of (Typ, Loc))),
- Expression =>
- Make_Aggregate (Loc,
- Expressions => Lst)));
+ Expression =>
+ Make_Aggregate (Loc,
+ Expressions => Lst)));
- Set_Enum_Pos_To_Rep (Typ, Arr);
+ Set_Enum_Pos_To_Rep (Typ, Arr);
+ end if;
-- Now we build the function that converts representation values to
-- position values. This function has the form:
projects / gcc.git / commitdiff