From: Javier Miranda <mira...@adacore.com>
This patch adds support for a new GNAT aspect/pragma for integer
type definitions to explicitly enforce the use of an unsigned
base type.
gcc/ada/ChangeLog:
* aspects.ads (Aspect_Unsigned_Base_Range): New aspect.
* checks.adb (Determine_Range): Handle types with unsigned base range
aspect.
(Enable_Overflow_Check): ditto
(Apply_Arithmetic_Overflow_Strict): ditto
* debug.adb (d_o): Document new usage.
* einfo.ads (Has_Unsigned_Base_Range_Aspect): New flag.
* exp_attr.adb (Expand_N_Attribute_Reference): No action since
it has been already handled at this stage.
* exp_ch4.adb (Expand_N_Op_Add): Generate aritmetic overflow check on
unsigned base range type operands.
(Expand_N_Op_Subtract): ditto
(Expand_N_Op_Multiply): ditto
(Expand_N_Op_Minus): ditto
* gen_il-fields.ads (Has_Unsigned_Base_Range_Aspect): New flag.
* gen_il-gen-gen_entities.adb (Has_Unsigned_Base_Range_Aspect): New
flag.
* gen_il-internals.adb (Has_Unsigned_Base_Range_Aspect): New flag.
* gnat1drv.adb (Adjust_Global_Switches): Handle -gnatd_o
* par-prag.adb (Pragma_Unsigned_Base_Range): No action since it will
be entirely handled by the semantic analyzer.
* rtsfind.ads (RE_Id): Add RE_Uns_[Add|Subtract|Multiply]_With_
Ovflo_Check
* sem_attr.ads (Attribute_Unsigned_Base_Range): Added to the set of
implementation defined attributes.
* sem_attr.adb (Analyze_Attribute): Analyze attribute
Unsigned_Base_Range.
(Eval_Attribute): Evaluate attribute Unsigned_Base_Range.
* sem_ch13.adb (Analyze_One_Aspect): Defer checks for this aspect to
the analysis of the corresponding pragma.
* sem_ch3.ads (Unsigned_Base_Range_Type_Declaration): New subprogram.
* sem_ch3.adb (Build_Derived_Numeric_Type): Inherit flag
Has_Unsigned_Base_Range_Aspect.
(Unsigned_Base_Range_Type_Declaration): New subprogram.
(Has_Pragma_Unsigned_Base_Range): New subprogram.
* sem_prag.adb (Analyze_Pragma): Handle Pragma_Unsigned_Base_Range.
* snames.adb-tmpl (Get_Pragma_Id): Handle Name_Unsigned_Base_Range.
(Is_Pragma_Name): ditto.
* snames.ads-tmpl (Name_Unsigned_Base_Range): New name.
(Attribute_Unsigned_Base_Range): New attribute.
(Pragma_Unsigned_Base_Range): New pragma.
* libgnat/s-aridou.ads (Add_With_Ovflo_Check): New routine for
Double_Uns.
(Subtract_With_Ovflo_Check): ditto.
(Multiply_With_Ovflo_Check): ditto.
* libgnat/s-aridou.adb (Add_With_Ovflo_Check): ditto.
(Subtract_With_Ovflo_Check): ditto.
(Multiply_With_Ovflo_Check): ditto.
* libgnat/s-arit64.ads (Uns_Add_With_Ovflo_Check64): New subprogram.
(Uns_Subtract_With_Ovflo_Check64): ditto.
(Uns_Multiply_With_Ovflo_Check64): ditto.
* libgnat/s-arit64.adb (Uns_Add_With_Ovflo_Check64): New subprogram.
(Uns_Subtract_With_Ovflo_Check64): ditto.
(Uns_Multiply_With_Ovflo_Check64): ditto.
* libgnat/s-arit128.ads (Uns_Add_With_Ovflo_Check128): New subprogram.
(Uns_Subtract_With_Ovflo_Check128): ditto.
(Uns_Multiply_With_Ovflo_Check128): ditto.
* libgnat/s-arit128.adb (Uns_Add_With_Ovflo_Check128): New subprogram.
(Uns_Subtract_With_Ovflo_Check128): ditto.
(Uns_Multiply_With_Ovflo_Check128): ditto.
* doc/gnat_rm/gnat_language_extensions.rst: Document unsigned
base range.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/aspects.ads | 5 +
gcc/ada/checks.adb | 62 ++++-
gcc/ada/debug.adb | 5 +-
.../doc/gnat_rm/gnat_language_extensions.rst | 23 ++
gcc/ada/einfo.ads | 6 +
gcc/ada/exp_attr.adb | 1 +
gcc/ada/exp_ch4.adb | 32 ++-
gcc/ada/gen_il-fields.ads | 1 +
gcc/ada/gen_il-gen-gen_entities.adb | 2 +
gcc/ada/gen_il-internals.adb | 2 +
gcc/ada/gnat1drv.adb | 6 +
gcc/ada/gnat_rm.texi | 150 ++++++-----
gcc/ada/gnat_ugn.texi | 4 +-
gcc/ada/libgnat/s-aridou.adb | 71 +++++
gcc/ada/libgnat/s-aridou.ads | 36 +++
gcc/ada/libgnat/s-arit128.adb | 10 +-
gcc/ada/libgnat/s-arit128.ads | 39 +++
gcc/ada/libgnat/s-arit64.adb | 10 +-
gcc/ada/libgnat/s-arit64.ads | 41 +++
gcc/ada/par-prag.adb | 1 +
gcc/ada/rtsfind.ads | 16 ++
gcc/ada/sem_attr.adb | 41 +++
gcc/ada/sem_attr.ads | 9 +
gcc/ada/sem_ch13.adb | 6 +
gcc/ada/sem_ch3.adb | 244 +++++++++++++++++-
gcc/ada/sem_ch3.ads | 6 +
gcc/ada/sem_prag.adb | 64 +++++
gcc/ada/snames.adb-tmpl | 5 +-
gcc/ada/snames.ads-tmpl | 12 +-
29 files changed, 830 insertions(+), 80 deletions(-)
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 737f1513606..88fea2e818c 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -240,6 +240,7 @@ package Aspects is
Aspect_Unmodified, -- GNAT
Aspect_Unreferenced, -- GNAT
Aspect_Unreferenced_Objects, -- GNAT
+ Aspect_Unsigned_Base_Range, -- GNAT
Aspect_Volatile,
Aspect_Volatile_Components,
Aspect_Volatile_Full_Access, -- GNAT
@@ -358,6 +359,7 @@ package Aspects is
Aspect_Unmodified => True,
Aspect_Unreferenced => True,
Aspect_Unreferenced_Objects => True,
+ Aspect_Unsigned_Base_Range => True,
Aspect_User_Aspect => True,
Aspect_Value_Size => True,
Aspect_Volatile_Full_Access => True,
@@ -629,6 +631,7 @@ package Aspects is
Aspect_Test_Case => False,
Aspect_Type_Invariant => False,
Aspect_Unimplemented => False,
+ Aspect_Unsigned_Base_Range => True,
Aspect_Unsuppress => False,
Aspect_User_Aspect => False,
Aspect_Value_Size => True,
@@ -852,6 +855,7 @@ package Aspects is
Aspect_Unmodified => Name_Unmodified,
Aspect_Unreferenced => Name_Unreferenced,
Aspect_Unreferenced_Objects => Name_Unreferenced_Objects,
+ Aspect_Unsigned_Base_Range => Name_Unsigned_Base_Range,
Aspect_Unsuppress => Name_Unsuppress,
Aspect_User_Aspect => Name_User_Aspect,
Aspect_Value_Size => Name_Value_Size,
@@ -1145,6 +1149,7 @@ package Aspects is
Aspect_Size => Rep_Aspect,
Aspect_Small => Rep_Aspect,
Aspect_Storage_Size => Rep_Aspect,
+ Aspect_Unsigned_Base_Range => Rep_Aspect,
Aspect_Value_Size => Rep_Aspect,
Aspect_Volatile => Rep_Aspect,
Aspect_Volatile_Components => Rep_Aspect,
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 0b3ae02259e..dfda0a6622b 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -970,15 +970,61 @@ package body Checks is
-- we use a different approach, expanding to:
-- typ (xxx_With_Ovflo_Check (Integer_NN (x), Integer_NN (y)))
+ -- or
+ -- typ (xxx_With_Ovflo_Check (Unsigned_NN (x), Unsigned_NN (y)))
-- where xxx is Add, Multiply or Subtract as appropriate
-- Find check type if one exists
if Dsiz <= System_Max_Integer_Size then
- Ctyp := Integer_Type_For (Dsiz, Uns => False);
+ Ctyp := Integer_Type_For (Dsiz,
+ Uns => Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)));
- -- No check type exists, use runtime call
+ -- No check type exists, and the type has the unsigned base range
+ -- aspect; use runtime call.
+
+ elsif Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)) then
+ if System_Max_Integer_Size = 64 then
+ Ctyp := RTE (RE_Unsigned_64);
+ else
+ Ctyp := RTE (RE_Unsigned_128);
+ end if;
+
+ if Nkind (N) = N_Op_Add then
+ if System_Max_Integer_Size = 64 then
+ Cent := RE_Uns_Add_With_Ovflo_Check64;
+ else
+ Cent := RE_Uns_Add_With_Ovflo_Check128;
+ end if;
+
+ elsif Nkind (N) = N_Op_Subtract then
+ if System_Max_Integer_Size = 64 then
+ Cent := RE_Uns_Subtract_With_Ovflo_Check64;
+ else
+ Cent := RE_Uns_Subtract_With_Ovflo_Check128;
+ end if;
+
+ else pragma Assert (Nkind (N) = N_Op_Multiply);
+ if System_Max_Integer_Size = 64 then
+ Cent := RE_Uns_Multiply_With_Ovflo_Check64;
+ else
+ Cent := RE_Uns_Multiply_With_Ovflo_Check128;
+ end if;
+ end if;
+
+ Rewrite (N,
+ OK_Convert_To (Typ,
+ Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (RTE (Cent), Loc),
+ Parameter_Associations => New_List (
+ OK_Convert_To (Ctyp, Left_Opnd (N)),
+ OK_Convert_To (Ctyp, Right_Opnd (N))))));
+
+ Analyze_And_Resolve (N, Typ);
+ return;
+
+ -- No check type exists, use runtime call (common case)
else
if System_Max_Integer_Size = 64 then
@@ -5492,7 +5538,9 @@ package body Checks is
-- bound, because that means the result could wrap.
-- Same applies for the lower bound if it is negative.
- if Is_Modular_Integer_Type (Typ) then
+ if Is_Modular_Integer_Type (Typ)
+ and then not Has_Unsigned_Base_Range_Aspect (Btyp)
+ then
if Lor > Lo and then Hir <= Hbound then
Lo := Lor;
end if;
@@ -6223,7 +6271,9 @@ package body Checks is
-- Nothing to do for unsigned integer types, which do not overflow
- elsif Is_Modular_Integer_Type (Typ) then
+ elsif Is_Modular_Integer_Type (Typ)
+ and then not Has_Unsigned_Base_Range_Aspect (Typ)
+ then
return;
end if;
@@ -8114,7 +8164,9 @@ package body Checks is
elsif Nkind (Expr) = N_Selected_Component
and then Present (Component_Clause (Entity (Selector_Name (Expr))))
- and then Is_Modular_Integer_Type (Typ)
+ and then
+ (Is_Modular_Integer_Type (Typ)
+ and then not Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)))
and then Modulus (Typ) = 2 ** Esize (Entity (Selector_Name (Expr)))
then
return;
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index f250d7429a9..b7c54a00066 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -152,7 +152,7 @@ package body Debug is
-- d_l Disable strict alignment of array types with aliased component
-- d_m Run adareducer on crash
-- d_n
- -- d_o
+ -- d_o Disable Backend_Overflow_Checks_On_Target; used for testing.
-- d_p Ignore assertion pragmas for elaboration
-- d_q Do not enforce freezing for equality operator of boolean subtype
-- d_r Disable the use of the return slot in functions
@@ -995,6 +995,9 @@ package body Debug is
-- d_l The compiler does not enforce the strict alignment of array types
-- that are declared with an aliased component.
+ -- d_o The compiler disables Backend_Overflow_Checks_On_Target; used to
+ -- test the frontend support on targets without overflow checks.
+
-- d_p The compiler ignores calls to subprograms which verify the run-time
-- semantics of invariants and postconditions in both the static and
-- dynamic elaboration models.
diff --git a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
index ff111ddd3a1..c35f2b088dc 100644
--- a/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
+++ b/gcc/ada/doc/gnat_rm/gnat_language_extensions.rst
@@ -581,6 +581,29 @@ Restricting the position of controlling parameter offers
several advantages:
* The result of a function is never a controlling result.
+``Unsigned_Base_Range`` aspect
+------------------------------
+
+A new pragma/aspect, ``Unsigned_Base_Range``, is introduced to explicitly
+enforce the use of an unsigned base type for signed integer types.
+RM-3.5.4(9) mandates a symmetric base range for signed integer types. This
+requirement often requires the use of larger data types for arithmetic
+operations, potentially introducing undesirable run-time overhead and
+performance penalties, particularly in embedded systems. For instance,
+on a 64-bit architecture, a 64-bit multiplication can be performed with
+a single hardware instruction, whereas a 128-bit multiplication requires
+multiple instructions and intermediate steps.
+
+Here is an example of this feature:
+
+.. code-block:: ada
+
+ type Uns_64 is range 0 .. 2 ** 64 - 1
+ with Size => 64,
+ Unsigned_Base_Range => True;
+
+It ensures that arithmetic operations of type ``Uns_64`` are carried
+out using 64 bits.
.. _Experimental_Language_Extensions:
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 97abab9e96a..6fbb76d4de0 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2174,6 +2174,11 @@ package Einfo is
-- on the partial view, to ensure that discriminants are properly
-- inherited in certain contexts.
+-- Has_Unsigned_Base_Range_Aspect [base type only]
+-- Defined in integer types. Set in the base type of an integer type for
+-- which the type has an Unsigned_Base_Range of True (whether by an
+-- aspect_specification, a pragma, or inheritance).
+
-- Has_Visible_Refinement
-- Defined in E_Abstract_State entities. Set when a state has at least
-- one refinement constituent and analysis is in the region between
@@ -6130,6 +6135,7 @@ package Einfo is
-- Static_Discrete_Predicate
-- Has_Biased_Representation
-- Has_Shift_Operator (base type only)
+ -- Has_Unsigned_Base_Range_Aspect (base type only)
-- No_Predicate_On_Actual
-- No_Dynamic_Predicate_On_Actual
-- Type_Low_Bound (synth)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 810248de1ac..4bc6006454b 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -8883,6 +8883,7 @@ package body Exp_Attr is
| Attribute_Type_Key
| Attribute_Unconstrained_Array
| Attribute_Universal_Literal_String
+ | Attribute_Unsigned_Base_Range
| Attribute_Wchar_T_Size
| Attribute_Word_Size
=>
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 43c94f37ba1..afdc243d302 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -7870,9 +7870,15 @@ package body Exp_Ch4 is
end if;
end if;
- -- Arithmetic overflow checks for signed integer/fixed point types
+ -- Arithmetic overflow checks for signed integer/fixed point types,
+ -- and signed integer types with unsigned base range aspect.
- if Is_Signed_Integer_Type (Typ) or else Is_Fixed_Point_Type (Typ) then
+ if Is_Signed_Integer_Type (Typ)
+ or else Is_Fixed_Point_Type (Typ)
+ or else
+ (Is_Modular_Integer_Type (Typ)
+ and then Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)))
+ then
Apply_Arithmetic_Overflow_Check (N);
return;
end if;
@@ -9387,7 +9393,11 @@ package body Exp_Ch4 is
end if;
if not Backend_Overflow_Checks_On_Target
- and then Is_Signed_Integer_Type (Typ)
+ and then
+ (Is_Signed_Integer_Type (Typ)
+ or else
+ (Is_Modular_Integer_Type (Typ)
+ and then Has_Unsigned_Base_Range_Aspect (Base_Type (Typ))))
and then Do_Overflow_Check (N)
then
-- Software overflow checking expands -expr into (0 - expr)
@@ -9811,7 +9821,11 @@ package body Exp_Ch4 is
-- Non-fixed point cases, check software overflow checking required
- elsif Is_Signed_Integer_Type (Etype (N)) then
+ elsif Is_Signed_Integer_Type (Etype (N))
+ or else
+ (Is_Modular_Integer_Type (Typ)
+ and then Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)))
+ then
Apply_Arithmetic_Overflow_Check (N);
end if;
@@ -10375,9 +10389,15 @@ package body Exp_Ch4 is
return;
end if;
- -- Arithmetic overflow checks for signed integer/fixed point types
+ -- Arithmetic overflow checks for signed integer/fixed point types,
+ -- and signed integer types with unsigned base range aspect.
- if Is_Signed_Integer_Type (Typ) or else Is_Fixed_Point_Type (Typ) then
+ if Is_Signed_Integer_Type (Typ)
+ or else Is_Fixed_Point_Type (Typ)
+ or else
+ (Is_Modular_Integer_Type (Typ)
+ and then Has_Unsigned_Base_Range_Aspect (Base_Type (Typ)))
+ then
Apply_Arithmetic_Overflow_Check (N);
end if;
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index 4ebefd2c68e..c9f9bc2c5ba 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -657,6 +657,7 @@ package Gen_IL.Fields is
Has_Thunks,
Has_Unchecked_Union,
Has_Unknown_Discriminants,
+ Has_Unsigned_Base_Range_Aspect,
Has_Visible_Refinement,
Has_Volatile_Components,
Has_Xref_Entry,
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb
b/gcc/ada/gen_il-gen-gen_entities.adb
index 00d49133af2..dd07b7a6e6e 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -497,6 +497,8 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (Has_Static_Predicate, Flag),
Sm (Has_Static_Predicate_Aspect, Flag),
Sm (Has_Unknown_Discriminants, Flag),
+ Sm (Has_Unsigned_Base_Range_Aspect, Flag,
+ Pre => "Is_Type (N)"),
Sm (Interface_Name, Node_Id),
Sm (Is_Abstract_Type, Flag),
Sm (Is_Actual_Subtype, Flag),
diff --git a/gcc/ada/gen_il-internals.adb b/gcc/ada/gen_il-internals.adb
index 3fa8b940542..77685f25c6a 100644
--- a/gcc/ada/gen_il-internals.adb
+++ b/gcc/ada/gen_il-internals.adb
@@ -291,6 +291,8 @@ package body Gen_IL.Internals is
return "Has_RACW";
when Has_SP_Choice =>
return "Has_SP_Choice";
+ when Has_Unsigned_Base_Range_Aspect =>
+ return "Has_Unsigned_Base_Range_Aspect";
when Ignore_SPARK_Mode_Pragmas =>
return "Ignore_SPARK_Mode_Pragmas";
when Is_CPP_Class =>
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index ee2c329aed7..176f2e2a4a2 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -175,6 +175,12 @@ procedure Gnat1drv is
Disable_ALI_File := True;
end if;
+ -- -gnatd_o disables backend overflow checks on target; used for testing
+
+ if Debug_Flag_Underscore_O then
+ Backend_Overflow_Checks_On_Target := False;
+ end if;
+
-- -gnatd.E sets Error_To_Warning mode, causing selected error messages
-- to be treated as warnings instead of errors.
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 5d7bedc67ee..47cf4941125 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT Reference Manual , Jul 24, 2025
+GNAT Reference Manual , Sep 05, 2025
AdaCore
@@ -908,6 +908,7 @@ Curated Extensions
* Constrained attribute for generic objects::
* Static aspect on intrinsic functions::
* First Controlling Parameter::
+* Unsigned_Base_Range aspect::
Deep delta Aggregates
@@ -30513,6 +30514,7 @@ Features activated via @code{-gnatX} or
* Constrained attribute for generic objects::
* Static aspect on intrinsic functions::
* First Controlling Parameter::
+* Unsigned_Base_Range aspect::
@end menu
@@ -31115,7 +31117,7 @@ The Ada 202x @code{Static} aspect can be specified on
Intrinsic imported functio
and the compiler will evaluate some of these intrinsics statically, in
particular the @code{Shift_Left} and @code{Shift_Right} intrinsics.
-@node First Controlling Parameter,,Static aspect on intrinsic
functions,Curated Extensions
+@node First Controlling Parameter,Unsigned_Base_Range aspect,Static aspect on
intrinsic functions,Curated Extensions
@anchor{gnat_rm/gnat_language_extensions
first-controlling-parameter}@anchor{457}
@subsection First Controlling Parameter
@@ -31215,8 +31217,34 @@ overriding a primitive or creating new one.
The result of a function is never a controlling result.
@end itemize
+@node Unsigned_Base_Range aspect,,First Controlling Parameter,Curated
Extensions
+@anchor{gnat_rm/gnat_language_extensions
unsigned-base-range-aspect}@anchor{458}
+@subsection @code{Unsigned_Base_Range} aspect
+
+
+A new pragma/aspect, @code{Unsigned_Base_Range}, is introduced to explicitly
+enforce the use of an unsigned base type for signed integer types.
+RM-3.5.4(9) mandates a symmetric base range for signed integer types. This
+requirement often requires the use of larger data types for arithmetic
+operations, potentially introducing undesirable run-time overhead and
+performance penalties, particularly in embedded systems. For instance,
+on a 64-bit architecture, a 64-bit multiplication can be performed with
+a single hardware instruction, whereas a 128-bit multiplication requires
+multiple instructions and intermediate steps.
+
+Here is an example of this feature:
+
+@example
+type Uns_64 is range 0 .. 2 ** 64 - 1
+ with Size => 64,
+ Unsigned_Base_Range => True;
+@end example
+
+It ensures that arithmetic operations of type @code{Uns_64} are carried
+out using 64 bits.
+
@node Experimental Language Extensions,,Curated Extensions,GNAT language
extensions
-@anchor{gnat_rm/gnat_language_extensions
experimental-language-extensions}@anchor{6b}@anchor{gnat_rm/gnat_language_extensions
id2}@anchor{458}
+@anchor{gnat_rm/gnat_language_extensions
experimental-language-extensions}@anchor{6b}@anchor{gnat_rm/gnat_language_extensions
id2}@anchor{459}
@section Experimental Language Extensions
@@ -31242,7 +31270,7 @@ Features activated via @code{-gnatX0} or
@end menu
@node Conditional when constructs,Implicit With,,Experimental Language
Extensions
-@anchor{gnat_rm/gnat_language_extensions
conditional-when-constructs}@anchor{459}
+@anchor{gnat_rm/gnat_language_extensions
conditional-when-constructs}@anchor{45a}
@subsection Conditional when constructs
@@ -31311,7 +31339,7 @@ end;
@end example
@node Implicit With,Storage Model,Conditional when constructs,Experimental
Language Extensions
-@anchor{gnat_rm/gnat_language_extensions implicit-with}@anchor{45a}
+@anchor{gnat_rm/gnat_language_extensions implicit-with}@anchor{45b}
@subsection Implicit With
@@ -31328,7 +31356,7 @@ end;
@end example
@node Storage Model,Attribute Super,Implicit With,Experimental Language
Extensions
-@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{45b}
+@anchor{gnat_rm/gnat_language_extensions storage-model}@anchor{45c}
@subsection Storage Model
@@ -31345,7 +31373,7 @@ memory models, in particular to support interactions
with GPU.
@end menu
@node Aspect Storage_Model_Type,Aspect Designated_Storage_Model,,Storage Model
-@anchor{gnat_rm/gnat_language_extensions aspect-storage-model-type}@anchor{45c}
+@anchor{gnat_rm/gnat_language_extensions aspect-storage-model-type}@anchor{45d}
@subsubsection Aspect Storage_Model_Type
@@ -31479,7 +31507,7 @@ end CUDA_Memory;
@end example
@node Aspect Designated_Storage_Model,Legacy Storage Pools,Aspect
Storage_Model_Type,Storage Model
-@anchor{gnat_rm/gnat_language_extensions
aspect-designated-storage-model}@anchor{45d}
+@anchor{gnat_rm/gnat_language_extensions
aspect-designated-storage-model}@anchor{45e}
@subsubsection Aspect Designated_Storage_Model
@@ -31557,7 +31585,7 @@ begin
@end example
@node Legacy Storage Pools,,Aspect Designated_Storage_Model,Storage Model
-@anchor{gnat_rm/gnat_language_extensions legacy-storage-pools}@anchor{45e}
+@anchor{gnat_rm/gnat_language_extensions legacy-storage-pools}@anchor{45f}
@subsubsection Legacy Storage Pools
@@ -31608,7 +31636,7 @@ type Acc is access Integer_Array with Storage_Pool =>
My_Pool;
can still be accepted as a shortcut for the new syntax.
@node Attribute Super,Simpler Accessibility Model,Storage Model,Experimental
Language Extensions
-@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{45f}
+@anchor{gnat_rm/gnat_language_extensions attribute-super}@anchor{460}
@subsection Attribute Super
@@ -31643,7 +31671,7 @@ end;
@end example
@node Simpler Accessibility Model,Case pattern matching,Attribute
Super,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions
simpler-accessibility-model}@anchor{460}
+@anchor{gnat_rm/gnat_language_extensions
simpler-accessibility-model}@anchor{461}
@subsection Simpler Accessibility Model
@@ -31674,7 +31702,7 @@ All of the refined rules are compatible with the [use
of anonymous access types
@end menu
@node Stand-alone objects,Subprogram parameters,,Simpler Accessibility Model
-@anchor{gnat_rm/gnat_language_extensions stand-alone-objects}@anchor{461}
+@anchor{gnat_rm/gnat_language_extensions stand-alone-objects}@anchor{462}
@subsubsection Stand-alone objects
@@ -31722,7 +31750,7 @@ of the RM 4.6 rule “The accessibility level of the
operand type shall not be
statically deeper than that of the target type …”.
@node Subprogram parameters,Function results,Stand-alone objects,Simpler
Accessibility Model
-@anchor{gnat_rm/gnat_language_extensions subprogram-parameters}@anchor{462}
+@anchor{gnat_rm/gnat_language_extensions subprogram-parameters}@anchor{463}
@subsubsection Subprogram parameters
@@ -31815,7 +31843,7 @@ end;
@end example
@node Function results,,Subprogram parameters,Simpler Accessibility Model
-@anchor{gnat_rm/gnat_language_extensions function-results}@anchor{463}
+@anchor{gnat_rm/gnat_language_extensions function-results}@anchor{464}
@subsubsection Function results
@@ -31943,7 +31971,7 @@ end;
@end example
@node Case pattern matching,Mutably Tagged Types with Size’Class
Aspect,Simpler Accessibility Model,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions case-pattern-matching}@anchor{464}
+@anchor{gnat_rm/gnat_language_extensions case-pattern-matching}@anchor{465}
@subsection Case pattern matching
@@ -32073,7 +32101,7 @@ message generated in such cases is usually “Capacity
exceeded in compiling
case statement with composite selector type”.
@node Mutably Tagged Types with Size’Class Aspect,Generalized
Finalization,Case pattern matching,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions
mutably-tagged-types-with-size-class-aspect}@anchor{465}
+@anchor{gnat_rm/gnat_language_extensions
mutably-tagged-types-with-size-class-aspect}@anchor{466}
@subsection Mutably Tagged Types with Size’Class Aspect
@@ -32244,7 +32272,7 @@ parameter exists (that is, before leaving the
corresponding callable construct).
This is analogous to the RM 6.4.1(18) rule about discriminated parameters.
@node Generalized Finalization,No_Raise aspect,Mutably Tagged Types with
Size’Class Aspect,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions generalized-finalization}@anchor{466}
+@anchor{gnat_rm/gnat_language_extensions generalized-finalization}@anchor{467}
@subsection Generalized Finalization
@@ -32315,7 +32343,7 @@ in this case.
@item
The @code{Adjust} and @code{Finalize} procedures are automatically considered
as
-having the @ref{467,,No_Raise aspect} specified for them. In particular, the
+having the @ref{468,,No_Raise aspect} specified for them. In particular, the
compiler has permission to enforce none of the guarantees specified by the
RM 7.6.1 (14/1) and subsequent subclauses.
@end itemize
@@ -32376,7 +32404,7 @@ end P;
@end menu
@node Finalizable tagged types,Composite types,,Generalized Finalization
-@anchor{gnat_rm/gnat_language_extensions finalizable-tagged-types}@anchor{468}
+@anchor{gnat_rm/gnat_language_extensions finalizable-tagged-types}@anchor{469}
@subsubsection Finalizable tagged types
@@ -32386,7 +32414,7 @@ dispatching whenever it makes sense, i.e. when the
object in question is of a
class-wide type and the class includes at least one finalizable tagged type.
@node Composite types,Interoperability with controlled types,Finalizable
tagged types,Generalized Finalization
-@anchor{gnat_rm/gnat_language_extensions composite-types}@anchor{469}
+@anchor{gnat_rm/gnat_language_extensions composite-types}@anchor{46a}
@subsubsection Composite types
@@ -32396,7 +32424,7 @@ in order to call the primitives of their components.
The dynamic semantics is
the same as for controlled components of composite types.
@node Interoperability with controlled types,,Composite types,Generalized
Finalization
-@anchor{gnat_rm/gnat_language_extensions
interoperability-with-controlled-types}@anchor{46a}
+@anchor{gnat_rm/gnat_language_extensions
interoperability-with-controlled-types}@anchor{46b}
@subsubsection Interoperability with controlled types
@@ -32406,7 +32434,7 @@ versa, but the stricter dynamic semantics, in other
words that of controlled
types, is applied in this case.
@node No_Raise aspect,Inference of Dependent Types in Generic
Instantiations,Generalized Finalization,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions
id3}@anchor{46b}@anchor{gnat_rm/gnat_language_extensions
no-raise-aspect}@anchor{467}
+@anchor{gnat_rm/gnat_language_extensions
id3}@anchor{46c}@anchor{gnat_rm/gnat_language_extensions
no-raise-aspect}@anchor{468}
@subsection No_Raise aspect
@@ -32416,7 +32444,7 @@ be raised during the execution of the subprogram, it is
caught at the end of
this execution and @code{Program_Error} is propagated to the caller.
@node Inference of Dependent Types in Generic
Instantiations,External_Initialization Aspect,No_Raise aspect,Experimental
Language Extensions
-@anchor{gnat_rm/gnat_language_extensions
inference-of-dependent-types-in-generic-instantiations}@anchor{46c}
+@anchor{gnat_rm/gnat_language_extensions
inference-of-dependent-types-in-generic-instantiations}@anchor{46d}
@subsection Inference of Dependent Types in Generic Instantiations
@@ -32493,7 +32521,7 @@ package Int_Array_Operations is new Array_Operations
@end example
@node External_Initialization Aspect,Finally construct,Inference of Dependent
Types in Generic Instantiations,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions
external-initialization-aspect}@anchor{46d}
+@anchor{gnat_rm/gnat_language_extensions
external-initialization-aspect}@anchor{46e}
@subsection External_Initialization Aspect
@@ -32534,7 +32562,7 @@ The maximum size of loaded files is limited to 2@w{^31}
bytes.
@end cartouche
@node Finally construct,Continue statement,External_Initialization
Aspect,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions finally-construct}@anchor{46e}
+@anchor{gnat_rm/gnat_language_extensions finally-construct}@anchor{46f}
@subsection Finally construct
@@ -32551,7 +32579,7 @@ This feature is similar to the one with the same name
in other languages such as
@end menu
@node Syntax<2>,Legality Rules<2>,,Finally construct
-@anchor{gnat_rm/gnat_language_extensions id4}@anchor{46f}
+@anchor{gnat_rm/gnat_language_extensions id4}@anchor{470}
@subsubsection Syntax
@@ -32566,7 +32594,7 @@ handled_sequence_of_statements ::=
@end example
@node Legality Rules<2>,Dynamic Semantics<2>,Syntax<2>,Finally construct
-@anchor{gnat_rm/gnat_language_extensions id5}@anchor{470}
+@anchor{gnat_rm/gnat_language_extensions id5}@anchor{471}
@subsubsection Legality Rules
@@ -32576,7 +32604,7 @@ to be transferred outside the finally part are
forbidden.
Goto & exit where the target is outside of the finally’s
@code{sequence_of_statements} are forbidden
@node Dynamic Semantics<2>,,Legality Rules<2>,Finally construct
-@anchor{gnat_rm/gnat_language_extensions id6}@anchor{471}
+@anchor{gnat_rm/gnat_language_extensions id6}@anchor{472}
@subsubsection Dynamic Semantics
@@ -32591,7 +32619,7 @@ execution, that is the finally block must be executed
in full even if the contai
aborted, or if the control is transferred out of the block.
@node Continue statement,Destructors,Finally construct,Experimental Language
Extensions
-@anchor{gnat_rm/gnat_language_extensions continue-statement}@anchor{472}
+@anchor{gnat_rm/gnat_language_extensions continue-statement}@anchor{473}
@subsection Continue statement
@@ -32609,7 +32637,7 @@ Note that @code{continue} is a keyword but it is not a
reserved word. This is a
configuration that does not exist in standard Ada.
@node Destructors,,Continue statement,Experimental Language Extensions
-@anchor{gnat_rm/gnat_language_extensions destructors}@anchor{473}
+@anchor{gnat_rm/gnat_language_extensions destructors}@anchor{474}
@subsection Destructors
@@ -32679,7 +32707,7 @@ imposing that rule on outside types that derive from
the private view of the
type.
@node Security Hardening Features,Obsolescent Features,GNAT language
extensions,Top
-@anchor{gnat_rm/security_hardening_features
doc}@anchor{474}@anchor{gnat_rm/security_hardening_features
id1}@anchor{475}@anchor{gnat_rm/security_hardening_features
security-hardening-features}@anchor{15}
+@anchor{gnat_rm/security_hardening_features
doc}@anchor{475}@anchor{gnat_rm/security_hardening_features
id1}@anchor{476}@anchor{gnat_rm/security_hardening_features
security-hardening-features}@anchor{15}
@chapter Security Hardening Features
@@ -32701,7 +32729,7 @@ change.
@end menu
@node Register Scrubbing,Stack Scrubbing,,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{476}
+@anchor{gnat_rm/security_hardening_features register-scrubbing}@anchor{477}
@section Register Scrubbing
@@ -32737,7 +32765,7 @@ programming languages, see @cite{Using the GNU Compiler
Collection (GCC)}.
@c Stack Scrubbing:
@node Stack Scrubbing,Hardened Conditionals,Register Scrubbing,Security
Hardening Features
-@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{477}
+@anchor{gnat_rm/security_hardening_features stack-scrubbing}@anchor{478}
@section Stack Scrubbing
@@ -32881,7 +32909,7 @@ Bar_Callable_Ptr.
@c Hardened Conditionals:
@node Hardened Conditionals,Hardened Booleans,Stack Scrubbing,Security
Hardening Features
-@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{478}
+@anchor{gnat_rm/security_hardening_features hardened-conditionals}@anchor{479}
@section Hardened Conditionals
@@ -32971,7 +32999,7 @@ be used with other programming languages supported by
GCC.
@c Hardened Booleans:
@node Hardened Booleans,Control Flow Redundancy,Hardened Conditionals,Security
Hardening Features
-@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{479}
+@anchor{gnat_rm/security_hardening_features hardened-booleans}@anchor{47a}
@section Hardened Booleans
@@ -33032,7 +33060,7 @@ and more details on that attribute, see @cite{Using the
GNU Compiler Collection
@c Control Flow Redundancy:
@node Control Flow Redundancy,,Hardened Booleans,Security Hardening Features
-@anchor{gnat_rm/security_hardening_features
control-flow-redundancy}@anchor{47a}
+@anchor{gnat_rm/security_hardening_features
control-flow-redundancy}@anchor{47b}
@section Control Flow Redundancy
@@ -33200,7 +33228,7 @@ see @cite{Using the GNU Compiler Collection (GCC)}.
These options
can be used with other programming languages supported by GCC.
@node Obsolescent Features,Compatibility and Porting Guide,Security Hardening
Features,Top
-@anchor{gnat_rm/obsolescent_features
doc}@anchor{47b}@anchor{gnat_rm/obsolescent_features
id1}@anchor{47c}@anchor{gnat_rm/obsolescent_features
obsolescent-features}@anchor{16}
+@anchor{gnat_rm/obsolescent_features
doc}@anchor{47c}@anchor{gnat_rm/obsolescent_features
id1}@anchor{47d}@anchor{gnat_rm/obsolescent_features
obsolescent-features}@anchor{16}
@chapter Obsolescent Features
@@ -33219,7 +33247,7 @@ compatibility purposes.
@end menu
@node pragma No_Run_Time,pragma Ravenscar,,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features
id2}@anchor{47d}@anchor{gnat_rm/obsolescent_features
pragma-no-run-time}@anchor{47e}
+@anchor{gnat_rm/obsolescent_features
id2}@anchor{47e}@anchor{gnat_rm/obsolescent_features
pragma-no-run-time}@anchor{47f}
@section pragma No_Run_Time
@@ -33232,7 +33260,7 @@ preferred usage is to use an appropriately configured
run-time that
includes just those features that are to be made accessible.
@node pragma Ravenscar,pragma Restricted_Run_Time,pragma
No_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features
id3}@anchor{47f}@anchor{gnat_rm/obsolescent_features
pragma-ravenscar}@anchor{480}
+@anchor{gnat_rm/obsolescent_features
id3}@anchor{480}@anchor{gnat_rm/obsolescent_features
pragma-ravenscar}@anchor{481}
@section pragma Ravenscar
@@ -33241,7 +33269,7 @@ The pragma @code{Ravenscar} has exactly the same effect
as pragma
is part of the new Ada 2005 standard.
@node pragma Restricted_Run_Time,pragma Task_Info,pragma Ravenscar,Obsolescent
Features
-@anchor{gnat_rm/obsolescent_features
id4}@anchor{481}@anchor{gnat_rm/obsolescent_features
pragma-restricted-run-time}@anchor{482}
+@anchor{gnat_rm/obsolescent_features
id4}@anchor{482}@anchor{gnat_rm/obsolescent_features
pragma-restricted-run-time}@anchor{483}
@section pragma Restricted_Run_Time
@@ -33251,7 +33279,7 @@ preferred since the Ada 2005 pragma @code{Profile} is
intended for
this kind of implementation dependent addition.
@node pragma Task_Info,package System Task_Info s-tasinf ads,pragma
Restricted_Run_Time,Obsolescent Features
-@anchor{gnat_rm/obsolescent_features
id5}@anchor{483}@anchor{gnat_rm/obsolescent_features
pragma-task-info}@anchor{484}
+@anchor{gnat_rm/obsolescent_features
id5}@anchor{484}@anchor{gnat_rm/obsolescent_features
pragma-task-info}@anchor{485}
@section pragma Task_Info
@@ -33277,7 +33305,7 @@ in the spec of package System.Task_Info in the runtime
library.
@node package System Task_Info s-tasinf ads,,pragma Task_Info,Obsolescent
Features
-@anchor{gnat_rm/obsolescent_features
package-system-task-info}@anchor{485}@anchor{gnat_rm/obsolescent_features
package-system-task-info-s-tasinf-ads}@anchor{486}
+@anchor{gnat_rm/obsolescent_features
package-system-task-info}@anchor{486}@anchor{gnat_rm/obsolescent_features
package-system-task-info-s-tasinf-ads}@anchor{487}
@section package System.Task_Info (@code{s-tasinf.ads})
@@ -33287,7 +33315,7 @@ to support the @code{Task_Info} pragma. The predefined
Ada package
standard replacement for GNAT’s @code{Task_Info} functionality.
@node Compatibility and Porting Guide,GNU Free Documentation
License,Obsolescent Features,Top
-@anchor{gnat_rm/compatibility_and_porting_guide
doc}@anchor{487}@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide
id1}@anchor{488}
+@anchor{gnat_rm/compatibility_and_porting_guide
doc}@anchor{488}@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-and-porting-guide}@anchor{17}@anchor{gnat_rm/compatibility_and_porting_guide
id1}@anchor{489}
@chapter Compatibility and Porting Guide
@@ -33309,7 +33337,7 @@ applications developed in other Ada environments.
@end menu
@node Writing Portable Fixed-Point Declarations,Compatibility with Ada
83,,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide
id2}@anchor{489}@anchor{gnat_rm/compatibility_and_porting_guide
writing-portable-fixed-point-declarations}@anchor{48a}
+@anchor{gnat_rm/compatibility_and_porting_guide
id2}@anchor{48a}@anchor{gnat_rm/compatibility_and_porting_guide
writing-portable-fixed-point-declarations}@anchor{48b}
@section Writing Portable Fixed-Point Declarations
@@ -33431,7 +33459,7 @@ If you follow this scheme you will be guaranteed that
your fixed-point
types will be portable.
@node Compatibility with Ada 83,Compatibility between Ada 95 and Ada
2005,Writing Portable Fixed-Point Declarations,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-with-ada-83}@anchor{48b}@anchor{gnat_rm/compatibility_and_porting_guide
id3}@anchor{48c}
+@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-with-ada-83}@anchor{48c}@anchor{gnat_rm/compatibility_and_porting_guide
id3}@anchor{48d}
@section Compatibility with Ada 83
@@ -33459,7 +33487,7 @@ following subsections treat the most likely issues to
be encountered.
@end menu
@node Legal Ada 83 programs that are illegal in Ada 95,More deterministic
semantics,,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide
id4}@anchor{48d}@anchor{gnat_rm/compatibility_and_porting_guide
legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{48e}
+@anchor{gnat_rm/compatibility_and_porting_guide
id4}@anchor{48e}@anchor{gnat_rm/compatibility_and_porting_guide
legal-ada-83-programs-that-are-illegal-in-ada-95}@anchor{48f}
@subsection Legal Ada 83 programs that are illegal in Ada 95
@@ -33559,7 +33587,7 @@ the fix is usually simply to add the @code{(<>)} to the
generic declaration.
@end itemize
@node More deterministic semantics,Changed semantics,Legal Ada 83 programs
that are illegal in Ada 95,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide
id5}@anchor{48f}@anchor{gnat_rm/compatibility_and_porting_guide
more-deterministic-semantics}@anchor{490}
+@anchor{gnat_rm/compatibility_and_porting_guide
id5}@anchor{490}@anchor{gnat_rm/compatibility_and_porting_guide
more-deterministic-semantics}@anchor{491}
@subsection More deterministic semantics
@@ -33587,7 +33615,7 @@ which open select branches are executed.
@end itemize
@node Changed semantics,Other language compatibility issues,More deterministic
semantics,Compatibility with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide
changed-semantics}@anchor{491}@anchor{gnat_rm/compatibility_and_porting_guide
id6}@anchor{492}
+@anchor{gnat_rm/compatibility_and_porting_guide
changed-semantics}@anchor{492}@anchor{gnat_rm/compatibility_and_porting_guide
id6}@anchor{493}
@subsection Changed semantics
@@ -33629,7 +33657,7 @@ covers only the restricted range.
@end itemize
@node Other language compatibility issues,,Changed semantics,Compatibility
with Ada 83
-@anchor{gnat_rm/compatibility_and_porting_guide
id7}@anchor{493}@anchor{gnat_rm/compatibility_and_porting_guide
other-language-compatibility-issues}@anchor{494}
+@anchor{gnat_rm/compatibility_and_porting_guide
id7}@anchor{494}@anchor{gnat_rm/compatibility_and_porting_guide
other-language-compatibility-issues}@anchor{495}
@subsection Other language compatibility issues
@@ -33662,7 +33690,7 @@ include @code{pragma Interface} and the floating point
type attributes
@end itemize
@node Compatibility between Ada 95 and Ada 2005,Implementation-dependent
characteristics,Compatibility with Ada 83,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-between-ada-95-and-ada-2005}@anchor{495}@anchor{gnat_rm/compatibility_and_porting_guide
id8}@anchor{496}
+@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-between-ada-95-and-ada-2005}@anchor{496}@anchor{gnat_rm/compatibility_and_porting_guide
id8}@anchor{497}
@section Compatibility between Ada 95 and Ada 2005
@@ -33734,7 +33762,7 @@ can declare a function returning a value from an
anonymous access type.
@end itemize
@node Implementation-dependent characteristics,Compatibility with Other Ada
Systems,Compatibility between Ada 95 and Ada 2005,Compatibility and Porting
Guide
-@anchor{gnat_rm/compatibility_and_porting_guide
id9}@anchor{497}@anchor{gnat_rm/compatibility_and_porting_guide
implementation-dependent-characteristics}@anchor{498}
+@anchor{gnat_rm/compatibility_and_porting_guide
id9}@anchor{498}@anchor{gnat_rm/compatibility_and_porting_guide
implementation-dependent-characteristics}@anchor{499}
@section Implementation-dependent characteristics
@@ -33757,7 +33785,7 @@ transition from certain Ada 83 compilers.
@end menu
@node Implementation-defined pragmas,Implementation-defined
attributes,,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide
id10}@anchor{499}@anchor{gnat_rm/compatibility_and_porting_guide
implementation-defined-pragmas}@anchor{49a}
+@anchor{gnat_rm/compatibility_and_porting_guide
id10}@anchor{49a}@anchor{gnat_rm/compatibility_and_porting_guide
implementation-defined-pragmas}@anchor{49b}
@subsection Implementation-defined pragmas
@@ -33779,7 +33807,7 @@ avoiding compiler rejection of units that contain such
pragmas; they are not
relevant in a GNAT context and hence are not otherwise implemented.
@node Implementation-defined attributes,Libraries,Implementation-defined
pragmas,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide
id11}@anchor{49b}@anchor{gnat_rm/compatibility_and_porting_guide
implementation-defined-attributes}@anchor{49c}
+@anchor{gnat_rm/compatibility_and_porting_guide
id11}@anchor{49c}@anchor{gnat_rm/compatibility_and_porting_guide
implementation-defined-attributes}@anchor{49d}
@subsection Implementation-defined attributes
@@ -33793,7 +33821,7 @@ Ada 83, GNAT supplies the attributes @code{Bit},
@code{Machine_Size} and
@code{Type_Class}.
@node Libraries,Elaboration order,Implementation-defined
attributes,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide
id12}@anchor{49d}@anchor{gnat_rm/compatibility_and_porting_guide
libraries}@anchor{49e}
+@anchor{gnat_rm/compatibility_and_porting_guide
id12}@anchor{49e}@anchor{gnat_rm/compatibility_and_porting_guide
libraries}@anchor{49f}
@subsection Libraries
@@ -33822,7 +33850,7 @@ be preferable to retrofit the application using modular
types.
@end itemize
@node Elaboration order,Target-specific
aspects,Libraries,Implementation-dependent characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide
elaboration-order}@anchor{49f}@anchor{gnat_rm/compatibility_and_porting_guide
id13}@anchor{4a0}
+@anchor{gnat_rm/compatibility_and_porting_guide
elaboration-order}@anchor{4a0}@anchor{gnat_rm/compatibility_and_porting_guide
id13}@anchor{4a1}
@subsection Elaboration order
@@ -33858,7 +33886,7 @@ pragmas either globally (as an effect of the `-gnatE'
switch) or locally
@end itemize
@node Target-specific aspects,,Elaboration order,Implementation-dependent
characteristics
-@anchor{gnat_rm/compatibility_and_porting_guide
id14}@anchor{4a1}@anchor{gnat_rm/compatibility_and_porting_guide
target-specific-aspects}@anchor{4a2}
+@anchor{gnat_rm/compatibility_and_porting_guide
id14}@anchor{4a2}@anchor{gnat_rm/compatibility_and_porting_guide
target-specific-aspects}@anchor{4a3}
@subsection Target-specific aspects
@@ -33871,10 +33899,10 @@ on the robustness of the original design. Moreover,
Ada 95 (and thus
Ada 2005, Ada 2012, and Ada 2022) are sometimes
incompatible with typical Ada 83 compiler practices regarding implicit
packing, the meaning of the Size attribute, and the size of access values.
-GNAT’s approach to these issues is described in @ref{4a3,,Representation
Clauses}.
+GNAT’s approach to these issues is described in @ref{4a4,,Representation
Clauses}.
@node Compatibility with Other Ada Systems,Representation
Clauses,Implementation-dependent characteristics,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-with-other-ada-systems}@anchor{4a4}@anchor{gnat_rm/compatibility_and_porting_guide
id15}@anchor{4a5}
+@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-with-other-ada-systems}@anchor{4a5}@anchor{gnat_rm/compatibility_and_porting_guide
id15}@anchor{4a6}
@section Compatibility with Other Ada Systems
@@ -33917,7 +33945,7 @@ far beyond this minimal set, as described in the next
section.
@end itemize
@node Representation Clauses,Compatibility with HP Ada 83,Compatibility with
Other Ada Systems,Compatibility and Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide
id16}@anchor{4a6}@anchor{gnat_rm/compatibility_and_porting_guide
representation-clauses}@anchor{4a3}
+@anchor{gnat_rm/compatibility_and_porting_guide
id16}@anchor{4a7}@anchor{gnat_rm/compatibility_and_porting_guide
representation-clauses}@anchor{4a4}
@section Representation Clauses
@@ -34010,7 +34038,7 @@ with thin pointers.
@end itemize
@node Compatibility with HP Ada 83,,Representation Clauses,Compatibility and
Porting Guide
-@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-with-hp-ada-83}@anchor{4a7}@anchor{gnat_rm/compatibility_and_porting_guide
id17}@anchor{4a8}
+@anchor{gnat_rm/compatibility_and_porting_guide
compatibility-with-hp-ada-83}@anchor{4a8}@anchor{gnat_rm/compatibility_and_porting_guide
id17}@anchor{4a9}
@section Compatibility with HP Ada 83
@@ -34040,7 +34068,7 @@ extension of package System.
@end itemize
@node GNU Free Documentation License,Index,Compatibility and Porting Guide,Top
-@anchor{share/gnu_free_documentation_license
doc}@anchor{4a9}@anchor{share/gnu_free_documentation_license
gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license
gnu-free-documentation-license}@anchor{4aa}
+@anchor{share/gnu_free_documentation_license
doc}@anchor{4aa}@anchor{share/gnu_free_documentation_license
gnu-fdl}@anchor{1}@anchor{share/gnu_free_documentation_license
gnu-free-documentation-license}@anchor{4ab}
@chapter GNU Free Documentation License
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 7b3175e3d27..48958f89256 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT User's Guide for Native Platforms , Jun 27, 2025
+GNAT User's Guide for Native Platforms , Sep 05, 2025
AdaCore
@@ -30297,8 +30297,8 @@ to permit their use in free software.
@printindex ge
-@anchor{d2}@w{ }
@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{
}
+@anchor{d2}@w{ }
@c %**end of body
@bye
diff --git a/gcc/ada/libgnat/s-aridou.adb b/gcc/ada/libgnat/s-aridou.adb
index dd2f150252a..aa9c5463649 100644
--- a/gcc/ada/libgnat/s-aridou.adb
+++ b/gcc/ada/libgnat/s-aridou.adb
@@ -128,6 +128,20 @@ is
Raise_Error;
end Add_With_Ovflo_Check;
+ --------------------------
+ -- Add_With_Ovflo_Check --
+ --------------------------
+
+ function Add_With_Ovflo_Check (X, Y : Double_Uns) return Double_Uns is
+ R : constant Double_Uns := X + Y;
+ begin
+ if R < X then
+ Raise_Error;
+ end if;
+
+ return R;
+ end Add_With_Ovflo_Check;
+
-------------------
-- Double_Divide --
-------------------
@@ -336,6 +350,49 @@ is
end if;
end Multiply_With_Ovflo_Check;
+ -------------------------------
+ -- Multiply_With_Ovflo_Check --
+ -------------------------------
+
+ function Multiply_With_Ovflo_Check (X, Y : Double_Uns) return Double_Uns is
+ Xhi : constant Single_Uns := Hi (X);
+ Xlo : constant Single_Uns := Lo (X);
+
+ Yhi : constant Single_Uns := Hi (Y);
+ Ylo : constant Single_Uns := Lo (Y);
+
+ T1, T2 : Double_Uns;
+
+ begin
+ if Xhi /= 0 then
+ if Yhi /= 0 then
+ Raise_Error;
+ else
+ T2 := Xhi * Ylo;
+ end if;
+
+ elsif Yhi /= 0 then
+ T2 := Xlo * Yhi;
+
+ else -- Yhi = Xhi = 0
+ T2 := 0;
+ end if;
+
+ -- Here we have T2 set to the contribution to the upper half of the
+ -- result from the upper halves of the input values.
+
+ T1 := Xlo * Ylo;
+ T2 := T2 + Hi (T1);
+
+ if Hi (T2) /= 0 then
+ Raise_Error;
+ end if;
+
+ T2 := Lo (T2) & Lo (T1);
+
+ return T2;
+ end Multiply_With_Ovflo_Check;
+
-----------------
-- Raise_Error --
-----------------
@@ -655,6 +712,20 @@ is
Raise_Error;
end Subtract_With_Ovflo_Check;
+ -------------------------------
+ -- Subtract_With_Ovflo_Check --
+ -------------------------------
+
+ function Subtract_With_Ovflo_Check (X, Y : Double_Uns) return Double_Uns is
+ R : constant Double_Uns := X - Y;
+ begin
+ if R > X then
+ Raise_Error;
+ end if;
+
+ return R;
+ end Subtract_With_Ovflo_Check;
+
----------------
-- To_Neg_Int --
----------------
diff --git a/gcc/ada/libgnat/s-aridou.ads b/gcc/ada/libgnat/s-aridou.ads
index f7240ded4d8..61b94a9a34c 100644
--- a/gcc/ada/libgnat/s-aridou.ads
+++ b/gcc/ada/libgnat/s-aridou.ads
@@ -53,6 +53,10 @@ generic
package System.Arith_Double
with Pure, SPARK_Mode
is
+ ----------------
+ -- Double_Int --
+ ----------------
+
function Add_With_Ovflo_Check (X, Y : Double_Int) return Double_Int;
-- Raises Constraint_Error if sum of operands overflows Double_Int,
-- otherwise returns this sum of operands as Double_Int.
@@ -145,4 +149,36 @@ is
-- Double_Uns division is then performed, the result is rounded, its sign
-- is corrected, and then returned.
+ ----------------
+ -- Double_Uns --
+ ----------------
+
+ function Add_With_Ovflo_Check (X, Y : Double_Uns) return Double_Uns;
+ -- Raises Constraint_Error if sum of operands overflows Double_Uns,
+ -- otherwise returns this sum of operands as Double_Uns.
+ --
+ -- The sum of ``X`` and ``Y`` is first computed. If the result is
+ -- lower than the first operand, then an overflow occurred and the
+ -- exception *Constraint_Error* is raised; otherwise the result is
+ -- correct.
+
+ function Subtract_With_Ovflo_Check (X, Y : Double_Uns) return Double_Uns;
+ -- Raises Constraint_Error if difference of operands overflows Double_Uns,
+ -- otherwise returns this difference of operands as Double_Int.
+ --
+ -- The subtraction of ``X`` and ``Y`` is first computed. If the result
+ -- is greater than the first operand, then an overflow occurred and the
+ -- exception *Constraint_Error* is raised; otherwise the result is
+ -- correct.
+
+ function Multiply_With_Ovflo_Check (X, Y : Double_Uns) return Double_Uns
+ with Convention => C;
+ -- Raises Constraint_Error if product of operands overflows Double_Uns,
+ -- otherwise returns this product of operands as Double_Uns. The code
+ -- generator may also generate direct calls to this routine.
+ --
+ -- The multiplication is done using pencil and paper algorithm applied to
+ -- Single_Uns, then the correct Double_Uns value is returned. Overflow
+ -- check is performed by looking at higher digits.
+
end System.Arith_Double;
diff --git a/gcc/ada/libgnat/s-arit128.adb b/gcc/ada/libgnat/s-arit128.adb
index c4ef40dcaf0..66c54f9bae6 100644
--- a/gcc/ada/libgnat/s-arit128.adb
+++ b/gcc/ada/libgnat/s-arit128.adb
@@ -34,7 +34,6 @@ with System.Arith_Double;
package body System.Arith_128
with SPARK_Mode
is
- subtype Uns128 is Interfaces.Unsigned_128;
subtype Uns64 is Interfaces.Unsigned_64;
use Interfaces;
@@ -62,4 +61,13 @@ is
Round : Boolean)
renames Impl.Double_Divide;
+ function Uns_Add_With_Ovflo_Check128 (X, Y : Uns128) return Uns128
+ renames Impl.Add_With_Ovflo_Check;
+
+ function Uns_Subtract_With_Ovflo_Check128 (X, Y : Uns128) return Uns128
+ renames Impl.Subtract_With_Ovflo_Check;
+
+ function Uns_Multiply_With_Ovflo_Check128 (X, Y : Uns128) return Uns128
+ renames Impl.Multiply_With_Ovflo_Check;
+
end System.Arith_128;
diff --git a/gcc/ada/libgnat/s-arit128.ads b/gcc/ada/libgnat/s-arit128.ads
index ea4ef6b3fa9..de1be0cc45c 100644
--- a/gcc/ada/libgnat/s-arit128.ads
+++ b/gcc/ada/libgnat/s-arit128.ads
@@ -41,6 +41,10 @@ with Interfaces;
package System.Arith_128
with Pure, SPARK_Mode
is
+ ------------
+ -- Int128 --
+ ------------
+
subtype Int128 is Interfaces.Integer_128;
function Add_With_Ovflo_Check128 (X, Y : Int128) return Int128;
@@ -81,4 +85,39 @@ is
-- then Q is the rounded quotient. The remainder R is not affected by the
-- setting of the Round flag.
+ ------------
+ -- Uns128 --
+ ------------
+
+ subtype Uns128 is Interfaces.Unsigned_128;
+
+ function Uns_Add_With_Ovflo_Check128 (X, Y : Uns128) return Uns128;
+ -- Raises Constraint_Error if sum of operands overflows 128 bits,
+ -- otherwise returns the 128-bit unsigned integer sum.
+ --
+ -- The sum of ``X`` and ``Y`` is first computed. If the result is
+ -- lower than the first operand, then an overflow occurred and the
+ -- exception *Constraint_Error* is raised; otherwise the result is
+ -- correct.
+
+ function Uns_Subtract_With_Ovflo_Check128 (X, Y : Uns128) return Uns128;
+ -- Raises Constraint_Error if difference of operands overflows 128 bits,
+ -- otherwise returns the 128-bit unsigned integer difference.
+ --
+ -- The subtraction of ``X`` and ``Y`` is first computed. If the result
+ -- is greater than the first operand, then an overflow occurred and the
+ -- exception *Constraint_Error* is raised; otherwise the result is
+ -- correct.
+
+ function Uns_Multiply_With_Ovflo_Check128 (X, Y : Uns128) return Uns128;
+ pragma Export (C, Uns_Multiply_With_Ovflo_Check128, "__gnat_uns_mulv128");
+ -- Raises Constraint_Error if product of operands overflows 128 bits,
+ -- otherwise returns the 128-bit signed integer product. The code
+ -- generator may also generate direct calls to this routine.
+ --
+ -- The multiplication is done using pencil and paper algorithm using base
+ -- 2**32. The multiplication is done on unsigned values, then the correct
+ -- unsigned value is returned. Overflow check is performed by looking at
+ -- higher digits.
+
end System.Arith_128;
diff --git a/gcc/ada/libgnat/s-arit64.adb b/gcc/ada/libgnat/s-arit64.adb
index 4e0336f4f16..fdf4331fa84 100644
--- a/gcc/ada/libgnat/s-arit64.adb
+++ b/gcc/ada/libgnat/s-arit64.adb
@@ -34,7 +34,6 @@ with System.Arith_Double;
package body System.Arith_64
with SPARK_Mode
is
- subtype Uns64 is Interfaces.Unsigned_64;
subtype Uns32 is Interfaces.Unsigned_32;
use Interfaces;
@@ -62,4 +61,13 @@ is
Round : Boolean)
renames Impl.Double_Divide;
+ function Uns_Add_With_Ovflo_Check64 (X, Y : Uns64) return Uns64
+ renames Impl.Add_With_Ovflo_Check;
+
+ function Uns_Subtract_With_Ovflo_Check64 (X, Y : Uns64) return Uns64
+ renames Impl.Subtract_With_Ovflo_Check;
+
+ function Uns_Multiply_With_Ovflo_Check64 (X, Y : Uns64) return Uns64
+ renames Impl.Multiply_With_Ovflo_Check;
+
end System.Arith_64;
diff --git a/gcc/ada/libgnat/s-arit64.ads b/gcc/ada/libgnat/s-arit64.ads
index 6e1278988bc..671f04cb81d 100644
--- a/gcc/ada/libgnat/s-arit64.ads
+++ b/gcc/ada/libgnat/s-arit64.ads
@@ -41,6 +41,10 @@ with Interfaces;
package System.Arith_64
with Pure, SPARK_Mode
is
+ -----------
+ -- Int64 --
+ -----------
+
subtype Int64 is Interfaces.Integer_64;
function Add_With_Ovflo_Check64 (X, Y : Int64) return Int64;
@@ -147,4 +151,41 @@ is
Round : Boolean) renames Double_Divide64;
-- Renamed procedure to preserve compatibility with earlier versions
+ -----------
+ -- Uns64 --
+ -----------
+
+ subtype Uns64 is Interfaces.Unsigned_64;
+
+ function Uns_Add_With_Ovflo_Check64 (X, Y : Uns64) return Uns64;
+ -- Raises Constraint_Error if sum of operands overflows 64 bits,
+ -- otherwise returns the 64 bits unsigned integer sum.
+ --
+ -- The sum of ``X`` and ``Y`` is first computed. If the result is
+ -- lower than the first operand, then an overflow occurred and the
+ -- exception *Constraint_Error* is raised; otherwise the result is
+ -- correct.
+
+ function Uns_Subtract_With_Ovflo_Check64 (X, Y : Uns64) return Uns64;
+ -- Raises Constraint_Error if difference of operands overflows 64 bits,
+ -- otherwise returns the 64-bit unsigned integer difference.
+ --
+ -- The subtraction of ``X`` and ``Y`` is first computed using wrap-around
+ -- semantics.
+ --
+ -- If the sign of the result is negative, then an overflow occurred and
+ -- the exception *Constraint_Error* is raised; otherwise the result is
+ -- correct.
+
+ function Uns_Multiply_With_Ovflo_Check64 (X, Y : Uns64) return Uns64;
+ pragma Export (C, Uns_Multiply_With_Ovflo_Check64, "__gnat_uns_mulv64");
+ -- Raises Constraint_Error if product of operands overflows 64 bits,
+ -- otherwise returns the 64-bit signed integer product. The code
+ -- generator may also generate direct calls to this routine.
+ --
+ -- The multiplication is done using pencil and paper algorithm using base
+ -- 2**32. The multiplication is done on unsigned values, then the correct
+ -- unsigned value is returned. Overflow check is performed by looking at
+ -- higher digits.
+
end System.Arith_64;
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 1bb81b0c79a..c4e6cce0271 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1608,6 +1608,7 @@ begin
| Pragma_Unreferenced
| Pragma_Unreferenced_Objects
| Pragma_Unreserve_All_Interrupts
+ | Pragma_Unsigned_Base_Range
| Pragma_Unsuppress
| Pragma_Unused
| Pragma_Use_VADS_Size
diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 37ed22b1c87..c26a3b9c5aa 100644
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -773,12 +773,20 @@ package Rtsfind is
RE_Scaled_Divide64, -- System.Arith_64
RE_Subtract_With_Ovflo_Check64, -- System.Arith_64
+ RE_Uns_Add_With_Ovflo_Check64, -- System.Arith_64
+ RE_Uns_Multiply_With_Ovflo_Check64, -- System.Arith_64
+ RE_Uns_Subtract_With_Ovflo_Check64, -- System.Arith_64
+
RE_Add_With_Ovflo_Check128, -- System.Arith_128
RE_Double_Divide128, -- System.Arith_128
RE_Multiply_With_Ovflo_Check128, -- System.Arith_128
RE_Subtract_With_Ovflo_Check128, -- System.Arith_128
RE_Scaled_Divide128, -- System.Arith_128
+ RE_Uns_Add_With_Ovflo_Check128, -- System.Arith_128
+ RE_Uns_Multiply_With_Ovflo_Check128, -- System.Arith_128
+ RE_Uns_Subtract_With_Ovflo_Check128, -- System.Arith_128
+
RE_Assert_Failure, -- System.Assertions
RE_Raise_Assert_Failure, -- System.Assertions
@@ -2421,12 +2429,20 @@ package Rtsfind is
RE_Scaled_Divide64 => System_Arith_64,
RE_Subtract_With_Ovflo_Check64 => System_Arith_64,
+ RE_Uns_Add_With_Ovflo_Check64 => System_Arith_64,
+ RE_Uns_Multiply_With_Ovflo_Check64 => System_Arith_64,
+ RE_Uns_Subtract_With_Ovflo_Check64 => System_Arith_64,
+
RE_Add_With_Ovflo_Check128 => System_Arith_128,
RE_Double_Divide128 => System_Arith_128,
RE_Multiply_With_Ovflo_Check128 => System_Arith_128,
RE_Subtract_With_Ovflo_Check128 => System_Arith_128,
RE_Scaled_Divide128 => System_Arith_128,
+ RE_Uns_Add_With_Ovflo_Check128 => System_Arith_128,
+ RE_Uns_Multiply_With_Ovflo_Check128 => System_Arith_128,
+ RE_Uns_Subtract_With_Ovflo_Check128 => System_Arith_128,
+
RE_Assert_Failure => System_Assertions,
RE_Raise_Assert_Failure => System_Assertions,
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 78b6318133a..3a494ad940f 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -7190,6 +7190,27 @@ package body Sem_Attr is
Analyze_Access_Attribute;
+ -------------------------
+ -- Unsigned_Base_Range --
+ -------------------------
+
+ -- GNAT core extension. The prefix of 'Unsigned_Base_Range must be a
+ -- signed integer type. The static result is a boolean that indicates
+ -- whether the base range is unsigned.
+
+ when Attribute_Unsigned_Base_Range =>
+ Check_E0;
+ Check_Integer_Type;
+ Check_Not_Incomplete_Type;
+ Set_Etype (N, Standard_Boolean);
+ Set_Is_Static_Expression (N, True);
+
+ if not Core_Extensions_Allowed then
+ Error_Msg_GNAT_Extension
+ ("'Unsigned_'Base_'Range", Sloc (N),
+ Is_Core_Extension => True);
+ end if;
+
------------
-- Update --
------------
@@ -10685,6 +10706,26 @@ package body Sem_Attr is
Set_Is_Static_Expression (N, True);
end Unconstrained_Array;
+ -------------------------
+ -- Unsigned_Base_Range --
+ -------------------------
+
+ when Attribute_Unsigned_Base_Range => Unsigned_Base_Range : declare
+ begin
+ Rewrite (N, New_Occurrence_Of (
+ Boolean_Literals (
+ Is_Integer_Type (P_Type)
+ and then
+ Has_Unsigned_Base_Range_Aspect (P_Base_Type)), Loc));
+
+ -- Analyze and resolve as boolean, note that this attribute is
+ -- a static attribute in GNAT.
+
+ Analyze_And_Resolve (N, Standard_Boolean);
+ Static := True;
+ Set_Is_Static_Expression (N, True);
+ end Unsigned_Base_Range;
+
-- Attribute Update is never static
when Attribute_Update =>
diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads
index 1c54370316e..4c8b60ca7f1 100644
--- a/gcc/ada/sem_attr.ads
+++ b/gcc/ada/sem_attr.ads
@@ -539,6 +539,15 @@ package Sem_Attr is
-- yields a value that can be called as long as the subprogram is in
-- scope (normal Ada 95 accessibility rules restrict this usage).
+ -------------------------
+ -- Unsigned_Base_Range --
+ -------------------------
+
+ Attribute_Unsigned_Base_Range => True,
+ -- GNAT core extension. The prefix of 'Unsigned_Base_Range must be a
+ -- signed integer type. The static result is a boolean that indicates
+ -- whether the base range is unsigned.
+
---------------
-- VADS_Size --
---------------
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 5adf5f48320..ce76b7dca01 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5193,6 +5193,12 @@ package body Sem_Ch13 is
Analyze_Aspect_Static;
goto Continue;
+ -- GNAT Core Extension: Checks for this aspect are performed
+ -- when the corresponding pragma is analyzed.
+
+ elsif A_Id = Aspect_Unsigned_Base_Range then
+ null;
+
-- Ada 2022 (AI12-0279)
elsif A_Id = Aspect_Yield then
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9f69e4f6cb8..04e3098bea7 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3191,9 +3191,29 @@ package body Sem_Ch3 is
end if;
end Check_Ops_From_Incomplete_Type;
+ -- Local variables
+
+ Is_Unsigned_Base_Range_Type_Decl : Boolean := False;
+
-- Start of processing for Analyze_Full_Type_Declaration
begin
+ if Present (Aspect_Specifications (Parent (Def))) then
+ declare
+ Asp : Node_Id;
+ begin
+ Asp := First (Aspect_Specifications (Parent (Def)));
+ while Present (Asp) loop
+ if Chars (Identifier (Asp)) = Name_Unsigned_Base_Range then
+ Is_Unsigned_Base_Range_Type_Decl := True;
+ exit;
+ end if;
+
+ Next (Asp);
+ end loop;
+ end;
+ end if;
+
Prev := Find_Type_Name (N);
-- The full view, if present, now points to the current type. If there
@@ -3329,7 +3349,11 @@ package body Sem_Ch3 is
Ordinary_Fixed_Point_Type_Declaration (T, Def);
when N_Signed_Integer_Type_Definition =>
- Signed_Integer_Type_Declaration (T, Def);
+ if Is_Unsigned_Base_Range_Type_Decl then
+ Unsigned_Base_Range_Type_Declaration (T, Def);
+ else
+ Signed_Integer_Type_Declaration (T, Def);
+ end if;
when N_Modular_Type_Definition =>
Modular_Type_Declaration (T, Def);
@@ -8235,6 +8259,8 @@ package body Sem_Ch3 is
if Is_Integer_Type (Parent_Type) then
Set_Has_Shift_Operator
(Implicit_Base, Has_Shift_Operator (Parent_Type));
+ Set_Has_Unsigned_Base_Range_Aspect
+ (Implicit_Base, Has_Unsigned_Base_Range_Aspect (Parent_Base));
end if;
-- The type of the bounds is that of the parent type, and they
@@ -23688,6 +23714,9 @@ package body Sem_Ch3 is
-- Check bound to make sure it is integral and static. If not, post
-- appropriate error message and set Errs flag
+ function Has_Pragma_Unsigned_Base_Range return Boolean;
+ -- Determine if type T has pragma Unsigned_Base_Range
+
---------------------
-- Can_Derive_From --
---------------------
@@ -23732,6 +23761,39 @@ package body Sem_Ch3 is
end if;
end Check_Bound;
+ ------------------------------------
+ -- Has_Pragma_Unsigned_Base_Range --
+ ------------------------------------
+
+ function Has_Pragma_Unsigned_Base_Range return Boolean is
+ Type_Decl : constant Node_Id := Parent (Def);
+ Nod : Node_Id := Next (Type_Decl);
+ Pragma_Arg : Node_Id;
+
+ begin
+ while Present (Nod) loop
+ if Nkind (Nod) = N_Pragma
+ and then Chars (Pragma_Identifier (Nod))
+ = Name_Unsigned_Base_Range
+ then
+ Pragma_Arg := First (Pragma_Argument_Associations (Nod));
+
+ -- Given that we are processing the full type declaration
+ -- of T, we cannot analyze yet the reference to the type
+ -- given in the pragma because it would be reported as
+ -- premature usage. Hence we rely on the name of the type.
+
+ if Chars (Expression (Pragma_Arg)) = Chars (T) then
+ return True;
+ end if;
+ end if;
+
+ Next (Nod);
+ end loop;
+
+ return False;
+ end Has_Pragma_Unsigned_Base_Range;
+
-- Start of processing for Signed_Integer_Type_Declaration
begin
@@ -23791,6 +23853,22 @@ package body Sem_Ch3 is
Check_Restriction (No_Long_Long_Integers, Def);
Base_Typ := Base_Type (Standard_Long_Long_Long_Integer);
+ -- For performance reasons, we defer checking pragma unsigned base
+ -- range until we have this case with bounds out of range (since
+ -- there is no need to perform this check for all signed integer
+ -- type declarations).
+
+ -- When the bounds of the integer type declaration are smaller,
+ -- and Unsigned_Base_Range is specified by means of a pragma, the
+ -- frontend handles the declaration as a regular signed integer
+ -- type declaration, and the base type is later adjusted (when the
+ -- pragma is processed); however, when the bounds are out of range
+ -- for the largest integer type we must handle it explicitly now.
+
+ elsif Has_Pragma_Unsigned_Base_Range then
+ Unsigned_Base_Range_Type_Declaration (T, Def);
+ return;
+
else
Base_Typ := Base_Type (Standard_Long_Long_Long_Integer);
Error_Msg_N ("integer type definition bounds out of range", Def);
@@ -23830,6 +23908,170 @@ package body Sem_Ch3 is
Set_Is_Constrained (T);
end Signed_Integer_Type_Declaration;
+ ------------------------------------------
+ -- Unsigned_Base_Range_Type_Declaration --
+ ------------------------------------------
+
+ procedure Unsigned_Base_Range_Type_Declaration
+ (T : Entity_Id;
+ Def : Node_Id)
+ is
+ Implicit_Base : Entity_Id;
+ Base_Typ : Entity_Id;
+ Lo_Val : Uint;
+ Hi_Val : Uint;
+ Errs : Boolean := False;
+ Lo : Node_Id;
+ Hi : Node_Id;
+
+ function Can_Derive_From (E : Entity_Id) return Boolean;
+ -- Determine whether given bounds allow derivation from specified type
+
+ procedure Check_Bound (Expr : Node_Id);
+ -- Check bound to make sure it is integral and static. If not, post
+ -- appropriate error message and set Errs flag
+
+ ---------------------
+ -- Can_Derive_From --
+ ---------------------
+
+ -- Note we check both bounds against both end values, to deal with
+ -- strange types like ones with a range of 0 .. -12341234.
+
+ function Can_Derive_From (E : Entity_Id) return Boolean is
+ Lo : constant Uint := Expr_Value (Type_Low_Bound (E));
+ Hi : constant Uint := Expr_Value (Type_High_Bound (E));
+ begin
+ return Lo <= Lo_Val and then Lo_Val <= Hi
+ and then
+ Lo <= Hi_Val and then Hi_Val <= Hi;
+ end Can_Derive_From;
+
+ -----------------
+ -- Check_Bound --
+ -----------------
+
+ procedure Check_Bound (Expr : Node_Id) is
+ begin
+ -- If a range constraint is used as an integer type definition, each
+ -- bound of the range must be defined by a static expression of some
+ -- integer type, but the two bounds need not have the same integer
+ -- type (Negative bounds are allowed.) (RM 3.5.4)
+
+ if not Is_Integer_Type (Etype (Expr)) then
+ Error_Msg_N
+ ("integer type definition bounds must be of integer type", Expr);
+ Errs := True;
+
+ elsif not Is_OK_Static_Expression (Expr) then
+ Flag_Non_Static_Expr
+ ("non-static expression used for integer type bound!", Expr);
+ Errs := True;
+
+ -- Otherwise the bounds are folded into literals
+
+ elsif Is_Entity_Name (Expr) then
+ Fold_Uint (Expr, Expr_Value (Expr), True);
+ end if;
+ end Check_Bound;
+
+ -- Start of processing for Unsigned_Base_Range_Type_Declaration
+
+ begin
+ -- Create an anonymous base type
+
+ Implicit_Base :=
+ Create_Itype (E_Modular_Integer_Type, Parent (Def), T, 'B');
+
+ -- Analyze and check the bounds, they can be of any integer type
+
+ Lo := Low_Bound (Def);
+ Hi := High_Bound (Def);
+
+ -- Arbitrarily use Integer as the type if either bound had an error
+
+ if Hi = Error or else Lo = Error then
+ Base_Typ := Any_Integer;
+ Set_Error_Posted (T, True);
+ Errs := True;
+
+ -- Here both bounds are OK expressions
+
+ else
+ Analyze_And_Resolve (Lo, Any_Integer);
+ Analyze_And_Resolve (Hi, Any_Integer);
+
+ Check_Bound (Lo);
+ Check_Bound (Hi);
+
+ if Errs then
+ Hi := Type_High_Bound (Standard_Long_Long_Long_Integer);
+ Lo := Type_Low_Bound (Standard_Long_Long_Long_Integer);
+ end if;
+
+ -- Find type to derive from
+
+ Lo_Val := Expr_Value (Lo);
+ Hi_Val := Expr_Value (Hi);
+
+ if Can_Derive_From (Standard_Short_Short_Unsigned) then
+ Base_Typ := Base_Type (Standard_Short_Short_Unsigned);
+
+ elsif Can_Derive_From (Standard_Short_Unsigned) then
+ Base_Typ := Base_Type (Standard_Short_Unsigned);
+
+ elsif Can_Derive_From (Standard_Unsigned) then
+ Base_Typ := Base_Type (Standard_Unsigned);
+
+ elsif Can_Derive_From (Standard_Long_Unsigned) then
+ Base_Typ := Base_Type (Standard_Long_Unsigned);
+
+ elsif Can_Derive_From (Standard_Long_Long_Unsigned) then
+ Base_Typ := Base_Type (Standard_Long_Long_Unsigned);
+
+ elsif Can_Derive_From (Standard_Long_Long_Long_Unsigned) then
+ Base_Typ := Base_Type (Standard_Long_Long_Long_Unsigned);
+
+ else
+ Base_Typ := Base_Type (Standard_Long_Long_Long_Unsigned);
+ Error_Msg_N ("unsigned type base range bounds out of range", Def);
+ Hi := Type_High_Bound (Standard_Long_Long_Long_Unsigned);
+ Lo := Type_Low_Bound (Standard_Long_Long_Long_Unsigned);
+ end if;
+ end if;
+
+ -- Set the type of the bounds to the implicit base: we cannot set it to
+ -- the new type, because this would be a forward reference for the code
+ -- generator and, if the original type is user-defined, this could even
+ -- lead to spurious semantic errors. Furthermore we do not set it to be
+ -- universal, because this could make it much larger than needed here.
+
+ if not Errs then
+ Set_Etype (Lo, Implicit_Base);
+ Set_Etype (Hi, Implicit_Base);
+ end if;
+
+ -- Complete both implicit base and declared first subtype entities. The
+ -- inheritance of the rep item chain ensures that SPARK-related pragmas
+ -- are not clobbered when the signed integer type acts as a full view of
+ -- a private type.
+
+ Set_Etype (Implicit_Base, Base_Typ);
+ Set_Size_Info (Implicit_Base, Base_Typ);
+ Set_RM_Size (Implicit_Base, RM_Size (Base_Typ));
+ Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Base_Typ));
+ Set_Scalar_Range (Implicit_Base, Scalar_Range (Base_Typ));
+ Set_Modulus (Implicit_Base, Modulus (Base_Typ));
+
+ Mutate_Ekind (T, E_Signed_Integer_Subtype);
+ Set_Etype (T, Implicit_Base);
+ Set_Size_Info (T, Implicit_Base);
+ Inherit_Rep_Item_Chain (T, Implicit_Base);
+ Set_Scalar_Range (T, Def);
+ Set_RM_Size (T, UI_From_Int (Minimum_Size (T)));
+ Set_Is_Constrained (T);
+ end Unsigned_Base_Range_Type_Declaration;
+
-------------------------------------
-- Warn_On_Inherently_Limited_Type --
-------------------------------------
diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads
index a97393d3cfe..0880dac0421 100644
--- a/gcc/ada/sem_ch3.ads
+++ b/gcc/ada/sem_ch3.ads
@@ -337,4 +337,10 @@ package Sem_Ch3 is
-- as referenced. Warnings on unused entities, if needed, go on the
-- partial view.
+ procedure Unsigned_Base_Range_Type_Declaration
+ (T : Entity_Id;
+ Def : Node_Id);
+ -- Create a new unsigned integer entity, and apply the constraint to obtain
+ -- the required first named subtype of this type.
+
end Sem_Ch3;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 191a6603f88..8bb309e64cc 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -28013,6 +28013,69 @@ package body Sem_Prag is
Unreserve_All_Interrupts := True;
end if;
+ --------------------------------
+ -- Pragma_Unsigned_Base_Range --
+ --------------------------------
+
+ when Pragma_Unsigned_Base_Range => Unsigned_Base_Range : declare
+ Arg : Node_Id;
+ E : Entity_Id := Empty;
+ Expr : Node_Id := Empty;
+
+ begin
+ GNAT_Pragma;
+ Check_At_Least_N_Arguments (1);
+ Check_At_Most_N_Arguments (2);
+
+ Arg := Get_Pragma_Arg (Arg1);
+ Check_Arg_Is_Identifier (Arg);
+
+ Analyze (Arg);
+ E := Entity (Arg);
+
+ if Present (Arg2) then
+ Check_Arg_Is_OK_Static_Expression (Arg2, Standard_Boolean);
+ Expr := Get_Pragma_Arg (Arg2);
+ Analyze_And_Resolve (Expr, Standard_Boolean);
+ end if;
+
+ if not Core_Extensions_Allowed then
+ Error_Msg_GNAT_Extension
+ ("'Unsigned_'Base_'Range", Sloc (N),
+ Is_Core_Extension => True);
+ return;
+
+ elsif not Is_Integer_Type (E)
+ or else Is_Modular_Integer_Type (E)
+ then
+ Error_Pragma_Arg
+ ("cannot apply pragma %",
+ "\& is not a signed integer type",
+ Arg1);
+
+ elsif Is_Derived_Type (E) then
+ Error_Pragma_Arg
+ ("pragma % cannot apply to derived type", Arg1);
+ end if;
+
+ Check_First_Subtype (Arg1);
+
+ -- Create the new unsigned integer base type entity, and apply
+ -- the constraint to create the first subtype of E.
+
+ Unsigned_Base_Range_Type_Declaration (E,
+ Def => Type_Definition (Parent (E)));
+
+ Set_Direct_Primitive_Operations (Base_Type (E), New_Elmt_List);
+ Set_Direct_Primitive_Operations (E,
+ Direct_Primitive_Operations (Base_Type (E)));
+ Ensure_Freeze_Node (Base_Type (E));
+ Set_First_Subtype_Link (Freeze_Node (Base_Type (E)), E);
+ Set_Has_Delayed_Freeze (E);
+
+ Set_Has_Unsigned_Base_Range_Aspect (Base_Type (E));
+ end Unsigned_Base_Range;
+
----------------
-- Unsuppress --
----------------
@@ -34730,6 +34793,7 @@ package body Sem_Prag is
Pragma_Unreferenced => 0,
Pragma_Unreferenced_Objects => 0,
Pragma_Unreserve_All_Interrupts => 0,
+ Pragma_Unsigned_Base_Range => 0,
Pragma_Unsuppress => 0,
Pragma_Unused => 0,
Pragma_Use_VADS_Size => 0,
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index 264b81e78ca..12662e30314 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -281,6 +281,8 @@ package body Snames is
return Pragma_Storage_Size;
when Name_Storage_Unit =>
return Pragma_Storage_Unit;
+ when Name_Unsigned_Base_Range =>
+ return Pragma_Unsigned_Base_Range;
when First_Pragma_Name .. Last_Pragma_Name =>
return Pragma_Id'Val (N - First_Pragma_Name);
when others =>
@@ -508,7 +510,8 @@ package body Snames is
or else N = Name_Priority
or else N = Name_Secondary_Stack_Size
or else N = Name_Storage_Size
- or else N = Name_Storage_Unit;
+ or else N = Name_Storage_Unit
+ or else N = Name_Unsigned_Base_Range;
end Is_Pragma_Name;
---------------------------------
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 6e6e85f946b..e83f6671668 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -574,7 +574,7 @@ package Snames is
Name_Extensions_Visible : constant Name_Id := N + $; -- GNAT
Name_External : constant Name_Id := N + $; -- GNAT
Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT
- Name_First_Controlling_Parameter : constant Name_Id := N + $;
+ Name_First_Controlling_Parameter : constant Name_Id := N + $; -- GNAT
Name_Ghost : constant Name_Id := N + $; -- GNAT
Name_Global : constant Name_Id := N + $; -- GNAT
Name_Ident : constant Name_Id := N + $; -- GNAT
@@ -722,6 +722,13 @@ package Snames is
Name_Unreferenced : constant Name_Id := N + $; -- GNAT
Name_Unreferenced_Objects : constant Name_Id := N + $; -- GNAT
Name_Unreserve_All_Interrupts : constant Name_Id := N + $; -- GNAT
+
+ -- Note: Unsigned_Base_Range is not in this list because its name matches
+ -- the name of the corresponding attribute. However, it is included in the
+ -- definition of the type Pragma_Id and the functions Get_Pragma_Id and
+ -- Is_Pragma_Name correctly recognize and process Unsigned_Base_Range.
+ -- Unsigned_Base_Range is a Core Extension pragma.
+
Name_Unused : constant Name_Id := N + $; -- GNAT
Name_Volatile : constant Name_Id := N + $;
Name_Volatile_Components : constant Name_Id := N + $;
@@ -1057,6 +1064,7 @@ package Snames is
Name_Unconstrained_Array : constant Name_Id := N + $; -- GNAT
Name_Universal_Literal_String : constant Name_Id := N + $; -- GNAT
Name_Unrestricted_Access : constant Name_Id := N + $; -- GNAT
+ Name_Unsigned_Base_Range : constant Name_Id := N + $; -- GNAT
Name_Update : constant Name_Id := N + $; -- GNAT
Name_VADS_Size : constant Name_Id := N + $; -- GNAT
Name_Val : constant Name_Id := N + $;
@@ -1600,6 +1608,7 @@ package Snames is
Attribute_Unconstrained_Array,
Attribute_Universal_Literal_String,
Attribute_Unrestricted_Access,
+ Attribute_Unsigned_Base_Range,
Attribute_Update,
Attribute_VADS_Size,
Attribute_Val,
@@ -2033,6 +2042,7 @@ package Snames is
Pragma_Secondary_Stack_Size,
Pragma_Storage_Size,
Pragma_Storage_Unit,
+ Pragma_Unsigned_Base_Range,
-- The value to represent an unknown or unrecognized pragma
--
2.43.0
