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
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,
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,
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,
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,
-- 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
-- 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;
-- 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;
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;
-- 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
-- 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.
* 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:
-- 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
-- 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)
| Attribute_Type_Key
| Attribute_Unconstrained_Array
| Attribute_Universal_Literal_String
+ | Attribute_Unsigned_Base_Range
| Attribute_Wchar_T_Size
| Attribute_Word_Size
=>
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;
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)
-- 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;
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;
Has_Thunks,
Has_Unchecked_Union,
Has_Unknown_Discriminants,
+ Has_Unsigned_Base_Range_Aspect,
Has_Visible_Refinement,
Has_Volatile_Components,
Has_Xref_Entry,
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),
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 =>
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.
@copying
@quotation
-GNAT Reference Manual , Jul 24, 2025
+GNAT Reference Manual , Sep 05, 2025
AdaCore
* Constrained attribute for generic objects::
* Static aspect on intrinsic functions::
* First Controlling Parameter::
+* Unsigned_Base_Range aspect::
Deep delta Aggregates
* Constrained attribute for generic objects::
* Static aspect on intrinsic functions::
* First Controlling Parameter::
+* Unsigned_Base_Range aspect::
@end menu
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
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
@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
@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
@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
@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
@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
@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
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
@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
@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
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
@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
@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
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
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
@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
@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
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
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
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
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
@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
@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
@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
@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
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
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
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
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
@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
@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
@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
@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
@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
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
@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
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
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
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
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})
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
@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
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
@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
@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
@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
@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
@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
@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
@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
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
@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
@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
@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
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
@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
@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
@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
@copying
@quotation
-GNAT User's Guide for Native Platforms , Jun 27, 2025
+GNAT User's Guide for Native Platforms , Sep 05, 2025
AdaCore
@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
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 --
-------------------
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 --
-----------------
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 --
----------------
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.
-- 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;
package body System.Arith_128
with SPARK_Mode
is
- subtype Uns128 is Interfaces.Unsigned_128;
subtype Uns64 is Interfaces.Unsigned_64;
use Interfaces;
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;
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;
-- 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;
package body System.Arith_64
with SPARK_Mode
is
- subtype Uns64 is Interfaces.Unsigned_64;
subtype Uns32 is Interfaces.Unsigned_32;
use Interfaces;
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;
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;
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;
| Pragma_Unreferenced
| Pragma_Unreferenced_Objects
| Pragma_Unreserve_All_Interrupts
+ | Pragma_Unsigned_Base_Range
| Pragma_Unsuppress
| Pragma_Unused
| Pragma_Use_VADS_Size
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
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,
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 --
------------
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 =>
-- 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 --
---------------
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
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
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);
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
-- 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 --
---------------------
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
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);
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 --
-------------------------------------
-- 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;
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 --
----------------
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,
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 =>
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;
---------------------------------
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
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 + $;
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 + $;
Attribute_Unconstrained_Array,
Attribute_Universal_Literal_String,
Attribute_Unrestricted_Access,
+ Attribute_Unsigned_Base_Range,
Attribute_Update,
Attribute_VADS_Size,
Attribute_Val,
Pragma_Secondary_Stack_Size,
Pragma_Storage_Size,
Pragma_Storage_Unit,
+ Pragma_Unsigned_Base_Range,
-- The value to represent an unknown or unrecognized pragma
projects / thirdparty / gcc.git / commitdiff
