+2014-10-17 Robert Dewar <dewar@adacore.com>
+
+ * sem_attr.adb (Eval_Attribute): Ensure that attribute
+ reference is not marked as being a static expression if the
+ prefix evaluation raises CE.
+
+2014-10-17 Robert Dewar <dewar@adacore.com>
+
+ * exp_pakd.adb: Move bit packed entity tables to spec.
+ * exp_pakd.ads: Move bit packed entity tables here from body.
+ * freeze.adb (Freeze_Array_Type): Check that packed array type
+ is supported.
+ * rtsfind.adb (PRE_Id_Table): New table (Entity_Not_Defined):
+ Specialize messages using PRE_Id_Table.
+ * uintp.ads, uintp.adb (UI_Image): New functional form.
+
+2014-10-17 Robert Dewar <dewar@adacore.com>
+
+ * aspects.ads, aspects.adb: Add Suppress_Initialization aspect.
+ * einfo.ads, einfo.adb (Suppress_Initialization): Now applies to
+ E_Variable.
+ * exp_ch3.adb (Default_Initialize_Object): Handle
+ Suppress_Initialization.
+ * exp_prag.adb (Expand_Pragma_Suppress_Initialization): New
+ procedure (Expand_N_Pragma): Handle Suppress_Initialization
+ (Expand_Pragma_Import_Or_Interface): Use Undo_Initialization
+ (Undo_Initialization): New procedure.
+ * sem_prag.adb (Analyze_Pragma, case Suppress_Initialization):
+ This is now allowed for E_Variable case.
+ * gnat_rm.texi: Document new aspect Suppress_Initialization
+ Suppress_Initialization aspect/pragma can apply to variable.
+ * einfo.ads: Minor reformatting.
+
+2014-10-17 Arnaud Charlet <charlet@adacore.com>
+
+ * spark_xrefs.ads: Add documentation pointer to Flow_Computed_Globals.
+
+2014-10-17 Robert Dewar <dewar@adacore.com>
+
+ * cstand.adb (Create_Standard): Mark Short_Integer as
+ implementation defined.
+ * sem_util.adb (Set_Entity_With_Checks): Avoid blow up for
+ compiler built with assertions for No_Implementation_Identifiers test.
+
2014-10-17 Robert Dewar <dewar@adacore.com>
* aspects.ads: Documentation fix, aspect Lock_Free does have a
Aspect_Stream_Size => Aspect_Stream_Size,
Aspect_Suppress => Aspect_Suppress,
Aspect_Suppress_Debug_Info => Aspect_Suppress_Debug_Info,
+ Aspect_Suppress_Initialization => Aspect_Suppress_Initialization,
Aspect_Synchronization => Aspect_Synchronization,
Aspect_Test_Case => Aspect_Test_Case,
Aspect_Thread_Local_Storage => Aspect_Thread_Local_Storage,
Aspect_Shared, -- GNAT (equivalent to Atomic)
Aspect_Simple_Storage_Pool_Type, -- GNAT
Aspect_Suppress_Debug_Info, -- GNAT
+ Aspect_Suppress_Initialization, -- GNAT
Aspect_Thread_Local_Storage, -- GNAT
Aspect_Unchecked_Union,
Aspect_Universal_Aliasing, -- GNAT
Aspect_Simple_Storage_Pool => True,
Aspect_Simple_Storage_Pool_Type => True,
Aspect_Suppress_Debug_Info => True,
+ Aspect_Suppress_Initialization => True,
Aspect_Thread_Local_Storage => True,
Aspect_Test_Case => True,
Aspect_Universal_Aliasing => True,
Aspect_Stream_Size => Name_Stream_Size,
Aspect_Suppress => Name_Suppress,
Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info,
+ Aspect_Suppress_Initialization => Name_Suppress_Initialization,
Aspect_Thread_Local_Storage => Name_Thread_Local_Storage,
Aspect_Synchronization => Name_Synchronization,
Aspect_Test_Case => Name_Test_Case,
Aspect_Stream_Size => Always_Delay,
Aspect_Suppress => Always_Delay,
Aspect_Suppress_Debug_Info => Always_Delay,
+ Aspect_Suppress_Initialization => Always_Delay,
Aspect_Thread_Local_Storage => Always_Delay,
Aspect_Type_Invariant => Always_Delay,
Aspect_Unchecked_Union => Always_Delay,
Build_Signed_Integer_Type
(Standard_Short_Integer, Standard_Short_Integer_Size);
+ Set_Is_Implementation_Defined (Standard_Short_Integer);
Build_Signed_Integer_Type
(Standard_Integer, Standard_Integer_Size);
function Suppress_Initialization (Id : E) return B is
begin
- pragma Assert (Is_Type (Id));
+ pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
return Flag105 (Id);
end Suppress_Initialization;
procedure Set_Suppress_Initialization (Id : E; V : B := True) is
begin
- pragma Assert (Is_Type (Id));
+ pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
Set_Flag105 (Id, V);
end Set_Suppress_Initialization;
-- vtable (i.e. the one to be extended by derivation).
-- Is_Tagged_Type (Flag55)
--- Defined in all entities. Set for an entity for a tagged type.
+-- Defined in all entities. Set for an entity that is a tagged type.
-- Is_Task_Interface (synthesized)
-- Defined in types that are interfaces. True if interface is declared as
-- avoid multiple elaboration warnings for the same variable.
-- Suppress_Initialization (Flag105)
--- Defined in all type and subtype entities. If set for the base type,
--- then the generation of initialization procedures is suppressed for the
--- type. Any other implicit initialiation (e.g. from the use of pragma
--- Initialize_Scalars) is also suppressed if this flag is set either for
--- the subtype in question, or for the base type. Set by use of pragma
--- Suppress_Initialization and also for internal entities where we know
--- that no initialization is required. For example, enumeration image
--- table entities set it.
+-- Defined in all variable, type and subtype entities. If set for a base
+-- type, then the generation of initialization procedures is suppressed
+-- for the type. Any other implicit initialiation (e.g. from the use of
+-- pragma Initialize_Scalars) is also suppressed if this flag is set for
+-- either the subtype in question, or for the base type. For variables,
+-- this flag suppresses all implicit initialization for the object, even
+-- if the type would normally require initialization. Set by use of
+-- pragma Suppress_Initialization and also for internal entities where
+-- we know that no initialization is required. For example, enumeration
+-- image table entities set it.
-- Suppress_Style_Checks (Flag165)
-- Defined in all entities. Suppresses any style checks specifically
-- is created for the base type, and this is the first named subtype).
E_Ordinary_Fixed_Point_Type,
- -- Ordinary fixed type, used for the anonymous base type of the
- -- fixed subtype created by an ordinary fixed point type declaration.
+ -- Ordinary fixed type, used for the anonymous base type of the fixed
+ -- subtype created by an ordinary fixed point type declaration.
E_Ordinary_Fixed_Point_Subtype,
-- Ordinary fixed point subtype, created by either an ordinary fixed
-- A record subtype, created by a record subtype declaration
E_Record_Type_With_Private,
- -- Used for types defined by a private extension declaration, and
- -- for tagged private types. Includes the fields for both private
- -- types and for record types (with the sole exception of
- -- Corresponding_Concurrent_Type which is obviously not needed).
- -- This entity is considered to be both a record type and
- -- a private type.
+ -- Used for types defined by a private extension declaration,
+ -- and for tagged private types. Includes the fields for both
+ -- private types and for record types (with the sole exception of
+ -- Corresponding_Concurrent_Type which is obviously not needed). This
+ -- entity is considered to be both a record type and a private type.
E_Record_Subtype_With_Private,
-- A subtype of a type defined by a private extension declaration
E_Private_Type,
- -- A private type, created by a private type declaration
- -- that has neither the keyword limited nor the keyword tagged.
+ -- A private type, created by a private type declaration that has
+ -- neither the keyword limited nor the keyword tagged.
E_Private_Subtype,
-- A subtype of a private type, created by a subtype declaration used
-- The type of an exception created by an exception declaration
E_Subprogram_Type,
- -- This is the designated type of an Access_To_Subprogram. Has type
- -- and signature like a subprogram entity, so can appear in calls,
- -- which are resolved like regular calls, except that such an entity
- -- is not overloadable.
+ -- This is the designated type of an Access_To_Subprogram. Has type and
+ -- signature like a subprogram entity, so can appear in calls, which
+ -- are resolved like regular calls, except that such an entity is not
+ -- overloadable.
---------------------------
-- Overloadable Entities --
E_Operator,
-- A predefined operator, appearing in Standard, or an implicitly
- -- defined concatenation operator created whenever an array is
- -- declared. We do not make normal derived operators explicit in
- -- the tree, but the concatenation operators are made explicit.
+ -- defined concatenation operator created whenever an array is declared.
+ -- We do not make normal derived operators explicit in the tree, but the
+ -- concatenation operators are made explicit.
E_Procedure,
-- A procedure, created by a procedure declaration or a procedure
-- OK_To_Rename (Flag247)
-- Optimize_Alignment_Space (Flag241)
-- Optimize_Alignment_Time (Flag242)
+ -- Suppress_Initialization (Flag105)
-- Treat_As_Volatile (Flag41)
-- Address_Clause (synth)
-- Alignment_Clause (synth)
-- END XEINFO INLINES
- -- The following Inline pragmas are *not* read by xeinfo when building
- -- the C version of this interface automatically (so the C version will
- -- end up making out of line calls). The pragma scan in xeinfo will be
- -- terminated on encountering the END XEINFO INLINES line. We inline
- -- things here which are small, but not of the canonical attribute
- -- access/set format that can be handled by xeinfo.
+ -- The following Inline pragmas are *not* read by xeinfo when building the
+ -- C version of this interface automatically (so the C version will end up
+ -- making out of line calls). The pragma scan in xeinfo will be terminated
+ -- on encountering the END XEINFO INLINES line. We inline things here which
+ -- are small, but not of the canonical attribute access/set format that can
+ -- be handled by xeinfo.
pragma Inline (Base_Type);
pragma Inline (Is_Base_Type);
-- known to be imported (i.e. whose declaration specifies the Import
-- aspect). Note that for objects with a pragma Import, we generate
-- initialization here, and then remove it downstream when processing
- -- the pragma.
+ -- the pragma. It is also suppressed for variables for which a pragma
+ -- Suppress_Initialization has been explicitly given
- if Is_Imported (Def_Id) then
+ if Is_Imported (Def_Id) or else Suppress_Initialization (Def_Id) then
return;
end if;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
-with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
-- right rotate into a left rotate, avoiding the subtract, if the machine
-- architecture provides such an instruction.
- ----------------------------------------------
- -- Entity Tables for Packed Access Routines --
- ----------------------------------------------
-
- -- For the cases of component size = 3,5-7,9-15,17-31,33-63 we call library
- -- routines. This table provides the entity for the proper routine.
-
- type E_Array is array (Int range 01 .. 63) of RE_Id;
-
- -- Array of Bits_nn entities. Note that we do not use library routines
- -- for the 8-bit and 16-bit cases, but we still fill in the table, using
- -- entries from System.Unsigned, because we also use this table for
- -- certain special unchecked conversions in the big-endian case.
-
- Bits_Id : constant E_Array :=
- (01 => RE_Bits_1,
- 02 => RE_Bits_2,
- 03 => RE_Bits_03,
- 04 => RE_Bits_4,
- 05 => RE_Bits_05,
- 06 => RE_Bits_06,
- 07 => RE_Bits_07,
- 08 => RE_Unsigned_8,
- 09 => RE_Bits_09,
- 10 => RE_Bits_10,
- 11 => RE_Bits_11,
- 12 => RE_Bits_12,
- 13 => RE_Bits_13,
- 14 => RE_Bits_14,
- 15 => RE_Bits_15,
- 16 => RE_Unsigned_16,
- 17 => RE_Bits_17,
- 18 => RE_Bits_18,
- 19 => RE_Bits_19,
- 20 => RE_Bits_20,
- 21 => RE_Bits_21,
- 22 => RE_Bits_22,
- 23 => RE_Bits_23,
- 24 => RE_Bits_24,
- 25 => RE_Bits_25,
- 26 => RE_Bits_26,
- 27 => RE_Bits_27,
- 28 => RE_Bits_28,
- 29 => RE_Bits_29,
- 30 => RE_Bits_30,
- 31 => RE_Bits_31,
- 32 => RE_Unsigned_32,
- 33 => RE_Bits_33,
- 34 => RE_Bits_34,
- 35 => RE_Bits_35,
- 36 => RE_Bits_36,
- 37 => RE_Bits_37,
- 38 => RE_Bits_38,
- 39 => RE_Bits_39,
- 40 => RE_Bits_40,
- 41 => RE_Bits_41,
- 42 => RE_Bits_42,
- 43 => RE_Bits_43,
- 44 => RE_Bits_44,
- 45 => RE_Bits_45,
- 46 => RE_Bits_46,
- 47 => RE_Bits_47,
- 48 => RE_Bits_48,
- 49 => RE_Bits_49,
- 50 => RE_Bits_50,
- 51 => RE_Bits_51,
- 52 => RE_Bits_52,
- 53 => RE_Bits_53,
- 54 => RE_Bits_54,
- 55 => RE_Bits_55,
- 56 => RE_Bits_56,
- 57 => RE_Bits_57,
- 58 => RE_Bits_58,
- 59 => RE_Bits_59,
- 60 => RE_Bits_60,
- 61 => RE_Bits_61,
- 62 => RE_Bits_62,
- 63 => RE_Bits_63);
-
- -- Array of Get routine entities. These are used to obtain an element from
- -- a packed array. The N'th entry is used to obtain elements from a packed
- -- array whose component size is N. RE_Null is used as a null entry, for
- -- the cases where a library routine is not used.
-
- Get_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Get_03,
- 04 => RE_Null,
- 05 => RE_Get_05,
- 06 => RE_Get_06,
- 07 => RE_Get_07,
- 08 => RE_Null,
- 09 => RE_Get_09,
- 10 => RE_Get_10,
- 11 => RE_Get_11,
- 12 => RE_Get_12,
- 13 => RE_Get_13,
- 14 => RE_Get_14,
- 15 => RE_Get_15,
- 16 => RE_Null,
- 17 => RE_Get_17,
- 18 => RE_Get_18,
- 19 => RE_Get_19,
- 20 => RE_Get_20,
- 21 => RE_Get_21,
- 22 => RE_Get_22,
- 23 => RE_Get_23,
- 24 => RE_Get_24,
- 25 => RE_Get_25,
- 26 => RE_Get_26,
- 27 => RE_Get_27,
- 28 => RE_Get_28,
- 29 => RE_Get_29,
- 30 => RE_Get_30,
- 31 => RE_Get_31,
- 32 => RE_Null,
- 33 => RE_Get_33,
- 34 => RE_Get_34,
- 35 => RE_Get_35,
- 36 => RE_Get_36,
- 37 => RE_Get_37,
- 38 => RE_Get_38,
- 39 => RE_Get_39,
- 40 => RE_Get_40,
- 41 => RE_Get_41,
- 42 => RE_Get_42,
- 43 => RE_Get_43,
- 44 => RE_Get_44,
- 45 => RE_Get_45,
- 46 => RE_Get_46,
- 47 => RE_Get_47,
- 48 => RE_Get_48,
- 49 => RE_Get_49,
- 50 => RE_Get_50,
- 51 => RE_Get_51,
- 52 => RE_Get_52,
- 53 => RE_Get_53,
- 54 => RE_Get_54,
- 55 => RE_Get_55,
- 56 => RE_Get_56,
- 57 => RE_Get_57,
- 58 => RE_Get_58,
- 59 => RE_Get_59,
- 60 => RE_Get_60,
- 61 => RE_Get_61,
- 62 => RE_Get_62,
- 63 => RE_Get_63);
-
- -- Array of Get routine entities to be used in the case where the packed
- -- array is itself a component of a packed structure, and therefore may not
- -- be fully aligned. This only affects the even sizes, since for the odd
- -- sizes, we do not get any fixed alignment in any case.
-
- GetU_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Get_03,
- 04 => RE_Null,
- 05 => RE_Get_05,
- 06 => RE_GetU_06,
- 07 => RE_Get_07,
- 08 => RE_Null,
- 09 => RE_Get_09,
- 10 => RE_GetU_10,
- 11 => RE_Get_11,
- 12 => RE_GetU_12,
- 13 => RE_Get_13,
- 14 => RE_GetU_14,
- 15 => RE_Get_15,
- 16 => RE_Null,
- 17 => RE_Get_17,
- 18 => RE_GetU_18,
- 19 => RE_Get_19,
- 20 => RE_GetU_20,
- 21 => RE_Get_21,
- 22 => RE_GetU_22,
- 23 => RE_Get_23,
- 24 => RE_GetU_24,
- 25 => RE_Get_25,
- 26 => RE_GetU_26,
- 27 => RE_Get_27,
- 28 => RE_GetU_28,
- 29 => RE_Get_29,
- 30 => RE_GetU_30,
- 31 => RE_Get_31,
- 32 => RE_Null,
- 33 => RE_Get_33,
- 34 => RE_GetU_34,
- 35 => RE_Get_35,
- 36 => RE_GetU_36,
- 37 => RE_Get_37,
- 38 => RE_GetU_38,
- 39 => RE_Get_39,
- 40 => RE_GetU_40,
- 41 => RE_Get_41,
- 42 => RE_GetU_42,
- 43 => RE_Get_43,
- 44 => RE_GetU_44,
- 45 => RE_Get_45,
- 46 => RE_GetU_46,
- 47 => RE_Get_47,
- 48 => RE_GetU_48,
- 49 => RE_Get_49,
- 50 => RE_GetU_50,
- 51 => RE_Get_51,
- 52 => RE_GetU_52,
- 53 => RE_Get_53,
- 54 => RE_GetU_54,
- 55 => RE_Get_55,
- 56 => RE_GetU_56,
- 57 => RE_Get_57,
- 58 => RE_GetU_58,
- 59 => RE_Get_59,
- 60 => RE_GetU_60,
- 61 => RE_Get_61,
- 62 => RE_GetU_62,
- 63 => RE_Get_63);
-
- -- Array of Set routine entities. These are used to assign an element of a
- -- packed array. The N'th entry is used to assign elements for a packed
- -- array whose component size is N. RE_Null is used as a null entry, for
- -- the cases where a library routine is not used.
-
- Set_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Set_03,
- 04 => RE_Null,
- 05 => RE_Set_05,
- 06 => RE_Set_06,
- 07 => RE_Set_07,
- 08 => RE_Null,
- 09 => RE_Set_09,
- 10 => RE_Set_10,
- 11 => RE_Set_11,
- 12 => RE_Set_12,
- 13 => RE_Set_13,
- 14 => RE_Set_14,
- 15 => RE_Set_15,
- 16 => RE_Null,
- 17 => RE_Set_17,
- 18 => RE_Set_18,
- 19 => RE_Set_19,
- 20 => RE_Set_20,
- 21 => RE_Set_21,
- 22 => RE_Set_22,
- 23 => RE_Set_23,
- 24 => RE_Set_24,
- 25 => RE_Set_25,
- 26 => RE_Set_26,
- 27 => RE_Set_27,
- 28 => RE_Set_28,
- 29 => RE_Set_29,
- 30 => RE_Set_30,
- 31 => RE_Set_31,
- 32 => RE_Null,
- 33 => RE_Set_33,
- 34 => RE_Set_34,
- 35 => RE_Set_35,
- 36 => RE_Set_36,
- 37 => RE_Set_37,
- 38 => RE_Set_38,
- 39 => RE_Set_39,
- 40 => RE_Set_40,
- 41 => RE_Set_41,
- 42 => RE_Set_42,
- 43 => RE_Set_43,
- 44 => RE_Set_44,
- 45 => RE_Set_45,
- 46 => RE_Set_46,
- 47 => RE_Set_47,
- 48 => RE_Set_48,
- 49 => RE_Set_49,
- 50 => RE_Set_50,
- 51 => RE_Set_51,
- 52 => RE_Set_52,
- 53 => RE_Set_53,
- 54 => RE_Set_54,
- 55 => RE_Set_55,
- 56 => RE_Set_56,
- 57 => RE_Set_57,
- 58 => RE_Set_58,
- 59 => RE_Set_59,
- 60 => RE_Set_60,
- 61 => RE_Set_61,
- 62 => RE_Set_62,
- 63 => RE_Set_63);
-
- -- Array of Set routine entities to be used in the case where the packed
- -- array is itself a component of a packed structure, and therefore may not
- -- be fully aligned. This only affects the even sizes, since for the odd
- -- sizes, we do not get any fixed alignment in any case.
-
- SetU_Id : constant E_Array :=
- (01 => RE_Null,
- 02 => RE_Null,
- 03 => RE_Set_03,
- 04 => RE_Null,
- 05 => RE_Set_05,
- 06 => RE_SetU_06,
- 07 => RE_Set_07,
- 08 => RE_Null,
- 09 => RE_Set_09,
- 10 => RE_SetU_10,
- 11 => RE_Set_11,
- 12 => RE_SetU_12,
- 13 => RE_Set_13,
- 14 => RE_SetU_14,
- 15 => RE_Set_15,
- 16 => RE_Null,
- 17 => RE_Set_17,
- 18 => RE_SetU_18,
- 19 => RE_Set_19,
- 20 => RE_SetU_20,
- 21 => RE_Set_21,
- 22 => RE_SetU_22,
- 23 => RE_Set_23,
- 24 => RE_SetU_24,
- 25 => RE_Set_25,
- 26 => RE_SetU_26,
- 27 => RE_Set_27,
- 28 => RE_SetU_28,
- 29 => RE_Set_29,
- 30 => RE_SetU_30,
- 31 => RE_Set_31,
- 32 => RE_Null,
- 33 => RE_Set_33,
- 34 => RE_SetU_34,
- 35 => RE_Set_35,
- 36 => RE_SetU_36,
- 37 => RE_Set_37,
- 38 => RE_SetU_38,
- 39 => RE_Set_39,
- 40 => RE_SetU_40,
- 41 => RE_Set_41,
- 42 => RE_SetU_42,
- 43 => RE_Set_43,
- 44 => RE_SetU_44,
- 45 => RE_Set_45,
- 46 => RE_SetU_46,
- 47 => RE_Set_47,
- 48 => RE_SetU_48,
- 49 => RE_Set_49,
- 50 => RE_SetU_50,
- 51 => RE_Set_51,
- 52 => RE_SetU_52,
- 53 => RE_Set_53,
- 54 => RE_SetU_54,
- 55 => RE_Set_55,
- 56 => RE_SetU_56,
- 57 => RE_Set_57,
- 58 => RE_SetU_58,
- 59 => RE_Set_59,
- 60 => RE_SetU_60,
- 61 => RE_Set_61,
- 62 => RE_SetU_62,
- 63 => RE_Set_63);
-
-----------------------
-- Local Subprograms --
-----------------------
-- Expand routines for manipulation of packed arrays
-with Types; use Types;
+with Rtsfind; use Rtsfind;
+with Types; use Types;
package Exp_Pakd is
-- and now, we do indeed have the same representation for the memory
-- version in the constrained and unconstrained cases.
+ ----------------------------------------------
+ -- Entity Tables for Packed Access Routines --
+ ----------------------------------------------
+
+ -- For the cases of component size = 3,5-7,9-15,17-31,33-63 we call library
+ -- routines. These tables provide the entity for the proper routine. They
+ -- are exposed in the spec to allow checking for the presence of the needed
+ -- routine when an array is subject to pragma Pack.
+
+ type E_Array is array (Int range 01 .. 63) of RE_Id;
+
+ -- Array of Bits_nn entities. Note that we do not use library routines
+ -- for the 8-bit and 16-bit cases, but we still fill in the table, using
+ -- entries from System.Unsigned, because we also use this table for
+ -- certain special unchecked conversions in the big-endian case.
+
+ Bits_Id : constant E_Array :=
+ (01 => RE_Bits_1,
+ 02 => RE_Bits_2,
+ 03 => RE_Bits_03,
+ 04 => RE_Bits_4,
+ 05 => RE_Bits_05,
+ 06 => RE_Bits_06,
+ 07 => RE_Bits_07,
+ 08 => RE_Unsigned_8,
+ 09 => RE_Bits_09,
+ 10 => RE_Bits_10,
+ 11 => RE_Bits_11,
+ 12 => RE_Bits_12,
+ 13 => RE_Bits_13,
+ 14 => RE_Bits_14,
+ 15 => RE_Bits_15,
+ 16 => RE_Unsigned_16,
+ 17 => RE_Bits_17,
+ 18 => RE_Bits_18,
+ 19 => RE_Bits_19,
+ 20 => RE_Bits_20,
+ 21 => RE_Bits_21,
+ 22 => RE_Bits_22,
+ 23 => RE_Bits_23,
+ 24 => RE_Bits_24,
+ 25 => RE_Bits_25,
+ 26 => RE_Bits_26,
+ 27 => RE_Bits_27,
+ 28 => RE_Bits_28,
+ 29 => RE_Bits_29,
+ 30 => RE_Bits_30,
+ 31 => RE_Bits_31,
+ 32 => RE_Unsigned_32,
+ 33 => RE_Bits_33,
+ 34 => RE_Bits_34,
+ 35 => RE_Bits_35,
+ 36 => RE_Bits_36,
+ 37 => RE_Bits_37,
+ 38 => RE_Bits_38,
+ 39 => RE_Bits_39,
+ 40 => RE_Bits_40,
+ 41 => RE_Bits_41,
+ 42 => RE_Bits_42,
+ 43 => RE_Bits_43,
+ 44 => RE_Bits_44,
+ 45 => RE_Bits_45,
+ 46 => RE_Bits_46,
+ 47 => RE_Bits_47,
+ 48 => RE_Bits_48,
+ 49 => RE_Bits_49,
+ 50 => RE_Bits_50,
+ 51 => RE_Bits_51,
+ 52 => RE_Bits_52,
+ 53 => RE_Bits_53,
+ 54 => RE_Bits_54,
+ 55 => RE_Bits_55,
+ 56 => RE_Bits_56,
+ 57 => RE_Bits_57,
+ 58 => RE_Bits_58,
+ 59 => RE_Bits_59,
+ 60 => RE_Bits_60,
+ 61 => RE_Bits_61,
+ 62 => RE_Bits_62,
+ 63 => RE_Bits_63);
+
+ -- Array of Get routine entities. These are used to obtain an element from
+ -- a packed array. The N'th entry is used to obtain elements from a packed
+ -- array whose component size is N. RE_Null is used as a null entry, for
+ -- the cases where a library routine is not used.
+
+ Get_Id : constant E_Array :=
+ (01 => RE_Null,
+ 02 => RE_Null,
+ 03 => RE_Get_03,
+ 04 => RE_Null,
+ 05 => RE_Get_05,
+ 06 => RE_Get_06,
+ 07 => RE_Get_07,
+ 08 => RE_Null,
+ 09 => RE_Get_09,
+ 10 => RE_Get_10,
+ 11 => RE_Get_11,
+ 12 => RE_Get_12,
+ 13 => RE_Get_13,
+ 14 => RE_Get_14,
+ 15 => RE_Get_15,
+ 16 => RE_Null,
+ 17 => RE_Get_17,
+ 18 => RE_Get_18,
+ 19 => RE_Get_19,
+ 20 => RE_Get_20,
+ 21 => RE_Get_21,
+ 22 => RE_Get_22,
+ 23 => RE_Get_23,
+ 24 => RE_Get_24,
+ 25 => RE_Get_25,
+ 26 => RE_Get_26,
+ 27 => RE_Get_27,
+ 28 => RE_Get_28,
+ 29 => RE_Get_29,
+ 30 => RE_Get_30,
+ 31 => RE_Get_31,
+ 32 => RE_Null,
+ 33 => RE_Get_33,
+ 34 => RE_Get_34,
+ 35 => RE_Get_35,
+ 36 => RE_Get_36,
+ 37 => RE_Get_37,
+ 38 => RE_Get_38,
+ 39 => RE_Get_39,
+ 40 => RE_Get_40,
+ 41 => RE_Get_41,
+ 42 => RE_Get_42,
+ 43 => RE_Get_43,
+ 44 => RE_Get_44,
+ 45 => RE_Get_45,
+ 46 => RE_Get_46,
+ 47 => RE_Get_47,
+ 48 => RE_Get_48,
+ 49 => RE_Get_49,
+ 50 => RE_Get_50,
+ 51 => RE_Get_51,
+ 52 => RE_Get_52,
+ 53 => RE_Get_53,
+ 54 => RE_Get_54,
+ 55 => RE_Get_55,
+ 56 => RE_Get_56,
+ 57 => RE_Get_57,
+ 58 => RE_Get_58,
+ 59 => RE_Get_59,
+ 60 => RE_Get_60,
+ 61 => RE_Get_61,
+ 62 => RE_Get_62,
+ 63 => RE_Get_63);
+
+ -- Array of Get routine entities to be used in the case where the packed
+ -- array is itself a component of a packed structure, and therefore may not
+ -- be fully aligned. This only affects the even sizes, since for the odd
+ -- sizes, we do not get any fixed alignment in any case.
+
+ GetU_Id : constant E_Array :=
+ (01 => RE_Null,
+ 02 => RE_Null,
+ 03 => RE_Get_03,
+ 04 => RE_Null,
+ 05 => RE_Get_05,
+ 06 => RE_GetU_06,
+ 07 => RE_Get_07,
+ 08 => RE_Null,
+ 09 => RE_Get_09,
+ 10 => RE_GetU_10,
+ 11 => RE_Get_11,
+ 12 => RE_GetU_12,
+ 13 => RE_Get_13,
+ 14 => RE_GetU_14,
+ 15 => RE_Get_15,
+ 16 => RE_Null,
+ 17 => RE_Get_17,
+ 18 => RE_GetU_18,
+ 19 => RE_Get_19,
+ 20 => RE_GetU_20,
+ 21 => RE_Get_21,
+ 22 => RE_GetU_22,
+ 23 => RE_Get_23,
+ 24 => RE_GetU_24,
+ 25 => RE_Get_25,
+ 26 => RE_GetU_26,
+ 27 => RE_Get_27,
+ 28 => RE_GetU_28,
+ 29 => RE_Get_29,
+ 30 => RE_GetU_30,
+ 31 => RE_Get_31,
+ 32 => RE_Null,
+ 33 => RE_Get_33,
+ 34 => RE_GetU_34,
+ 35 => RE_Get_35,
+ 36 => RE_GetU_36,
+ 37 => RE_Get_37,
+ 38 => RE_GetU_38,
+ 39 => RE_Get_39,
+ 40 => RE_GetU_40,
+ 41 => RE_Get_41,
+ 42 => RE_GetU_42,
+ 43 => RE_Get_43,
+ 44 => RE_GetU_44,
+ 45 => RE_Get_45,
+ 46 => RE_GetU_46,
+ 47 => RE_Get_47,
+ 48 => RE_GetU_48,
+ 49 => RE_Get_49,
+ 50 => RE_GetU_50,
+ 51 => RE_Get_51,
+ 52 => RE_GetU_52,
+ 53 => RE_Get_53,
+ 54 => RE_GetU_54,
+ 55 => RE_Get_55,
+ 56 => RE_GetU_56,
+ 57 => RE_Get_57,
+ 58 => RE_GetU_58,
+ 59 => RE_Get_59,
+ 60 => RE_GetU_60,
+ 61 => RE_Get_61,
+ 62 => RE_GetU_62,
+ 63 => RE_Get_63);
+
+ -- Array of Set routine entities. These are used to assign an element of a
+ -- packed array. The N'th entry is used to assign elements for a packed
+ -- array whose component size is N. RE_Null is used as a null entry, for
+ -- the cases where a library routine is not used.
+
+ Set_Id : constant E_Array :=
+ (01 => RE_Null,
+ 02 => RE_Null,
+ 03 => RE_Set_03,
+ 04 => RE_Null,
+ 05 => RE_Set_05,
+ 06 => RE_Set_06,
+ 07 => RE_Set_07,
+ 08 => RE_Null,
+ 09 => RE_Set_09,
+ 10 => RE_Set_10,
+ 11 => RE_Set_11,
+ 12 => RE_Set_12,
+ 13 => RE_Set_13,
+ 14 => RE_Set_14,
+ 15 => RE_Set_15,
+ 16 => RE_Null,
+ 17 => RE_Set_17,
+ 18 => RE_Set_18,
+ 19 => RE_Set_19,
+ 20 => RE_Set_20,
+ 21 => RE_Set_21,
+ 22 => RE_Set_22,
+ 23 => RE_Set_23,
+ 24 => RE_Set_24,
+ 25 => RE_Set_25,
+ 26 => RE_Set_26,
+ 27 => RE_Set_27,
+ 28 => RE_Set_28,
+ 29 => RE_Set_29,
+ 30 => RE_Set_30,
+ 31 => RE_Set_31,
+ 32 => RE_Null,
+ 33 => RE_Set_33,
+ 34 => RE_Set_34,
+ 35 => RE_Set_35,
+ 36 => RE_Set_36,
+ 37 => RE_Set_37,
+ 38 => RE_Set_38,
+ 39 => RE_Set_39,
+ 40 => RE_Set_40,
+ 41 => RE_Set_41,
+ 42 => RE_Set_42,
+ 43 => RE_Set_43,
+ 44 => RE_Set_44,
+ 45 => RE_Set_45,
+ 46 => RE_Set_46,
+ 47 => RE_Set_47,
+ 48 => RE_Set_48,
+ 49 => RE_Set_49,
+ 50 => RE_Set_50,
+ 51 => RE_Set_51,
+ 52 => RE_Set_52,
+ 53 => RE_Set_53,
+ 54 => RE_Set_54,
+ 55 => RE_Set_55,
+ 56 => RE_Set_56,
+ 57 => RE_Set_57,
+ 58 => RE_Set_58,
+ 59 => RE_Set_59,
+ 60 => RE_Set_60,
+ 61 => RE_Set_61,
+ 62 => RE_Set_62,
+ 63 => RE_Set_63);
+
+ -- Array of Set routine entities to be used in the case where the packed
+ -- array is itself a component of a packed structure, and therefore may not
+ -- be fully aligned. This only affects the even sizes, since for the odd
+ -- sizes, we do not get any fixed alignment in any case.
+
+ SetU_Id : constant E_Array :=
+ (01 => RE_Null,
+ 02 => RE_Null,
+ 03 => RE_Set_03,
+ 04 => RE_Null,
+ 05 => RE_Set_05,
+ 06 => RE_SetU_06,
+ 07 => RE_Set_07,
+ 08 => RE_Null,
+ 09 => RE_Set_09,
+ 10 => RE_SetU_10,
+ 11 => RE_Set_11,
+ 12 => RE_SetU_12,
+ 13 => RE_Set_13,
+ 14 => RE_SetU_14,
+ 15 => RE_Set_15,
+ 16 => RE_Null,
+ 17 => RE_Set_17,
+ 18 => RE_SetU_18,
+ 19 => RE_Set_19,
+ 20 => RE_SetU_20,
+ 21 => RE_Set_21,
+ 22 => RE_SetU_22,
+ 23 => RE_Set_23,
+ 24 => RE_SetU_24,
+ 25 => RE_Set_25,
+ 26 => RE_SetU_26,
+ 27 => RE_Set_27,
+ 28 => RE_SetU_28,
+ 29 => RE_Set_29,
+ 30 => RE_SetU_30,
+ 31 => RE_Set_31,
+ 32 => RE_Null,
+ 33 => RE_Set_33,
+ 34 => RE_SetU_34,
+ 35 => RE_Set_35,
+ 36 => RE_SetU_36,
+ 37 => RE_Set_37,
+ 38 => RE_SetU_38,
+ 39 => RE_Set_39,
+ 40 => RE_SetU_40,
+ 41 => RE_Set_41,
+ 42 => RE_SetU_42,
+ 43 => RE_Set_43,
+ 44 => RE_SetU_44,
+ 45 => RE_Set_45,
+ 46 => RE_SetU_46,
+ 47 => RE_Set_47,
+ 48 => RE_SetU_48,
+ 49 => RE_Set_49,
+ 50 => RE_SetU_50,
+ 51 => RE_Set_51,
+ 52 => RE_SetU_52,
+ 53 => RE_Set_53,
+ 54 => RE_SetU_54,
+ 55 => RE_Set_55,
+ 56 => RE_SetU_56,
+ 57 => RE_Set_57,
+ 58 => RE_SetU_58,
+ 59 => RE_Set_59,
+ 60 => RE_SetU_60,
+ 61 => RE_Set_61,
+ 62 => RE_SetU_62,
+ 63 => RE_Set_63);
+
-----------------
-- Subprograms --
-----------------
procedure Expand_Pragma_Loop_Variant (N : Node_Id);
procedure Expand_Pragma_Psect_Object (N : Node_Id);
procedure Expand_Pragma_Relative_Deadline (N : Node_Id);
+ procedure Expand_Pragma_Suppress_Initialization (N : Node_Id);
+
+ procedure Undo_Initialization (Def_Id : Entity_Id; N : Node_Id);
+ -- This procedure is used to undo initialization already done for Def_Id,
+ -- which is always an E_Variable, in response to the occurrence of the
+ -- pragma N, a pragma Interface, Import, or Suppress_Initialization. In all
+ -- these cases we want no initialization to occur, but we have already done
+ -- the initialization by the time we see the pragma, so we have to undo it.
----------
-- Arg1 --
when Pragma_Relative_Deadline =>
Expand_Pragma_Relative_Deadline (N);
+ when Pragma_Suppress_Initialization =>
+ Expand_Pragma_Suppress_Initialization (N);
+
-- All other pragmas need no expander action
when others => null;
procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is
Def_Id : Entity_Id;
- Init_Call : Node_Id;
begin
-- In Relaxed_RM_Semantics, support old Ada 83 style:
Def_Id := Entity (Arg2 (N));
end if;
- -- Variable case
+ -- Variable case (we have to undo any initialization already done)
if Ekind (Def_Id) = E_Variable then
-
- -- When applied to a variable, the default initialization must not be
- -- done. As it is already done when the pragma is found, we just get
- -- rid of the call the initialization procedure which followed the
- -- object declaration. The call is inserted after the declaration,
- -- but validity checks may also have been inserted and thus the
- -- initialization call does not necessarily appear immediately
- -- after the object declaration.
-
- -- We can't use the freezing mechanism for this purpose, since we
- -- have to elaborate the initialization expression when it is first
- -- seen (so this elaboration cannot be deferred to the freeze point).
-
- -- Find and remove generated initialization call for object, if any
-
- Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N);
-
- -- Any default initialization expression should be removed (e.g.
- -- null defaults for access objects, zero initialization of packed
- -- bit arrays). Imported objects aren't allowed to have explicit
- -- initialization, so the expression must have been generated by
- -- the compiler.
-
- if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
- Set_Expression (Parent (Def_Id), Empty);
- end if;
+ Undo_Initialization (Def_Id, N);
-- Case of exception with convention C++
end if;
end Expand_Pragma_Relative_Deadline;
+ -------------------------------------------
+ -- Expand_Pragma_Suppress_Initialization --
+ -------------------------------------------
+
+ procedure Expand_Pragma_Suppress_Initialization (N : Node_Id) is
+ Def_Id : constant Entity_Id := Entity (Arg1 (N));
+
+ begin
+ -- Variable case (we have to undo any initialization already done)
+
+ if Ekind (Def_Id) = E_Variable then
+ Undo_Initialization (Def_Id, N);
+ end if;
+ end Expand_Pragma_Suppress_Initialization;
+
+ -------------------------
+ -- Undo_Initialization --
+ -------------------------
+
+ procedure Undo_Initialization (Def_Id : Entity_Id; N : Node_Id) is
+ Init_Call : Node_Id;
+
+ begin
+ -- When applied to a variable, the default initialization must not be
+ -- done. As it is already done when the pragma is found, we just get rid
+ -- of the call the initialization procedure which followed the object
+ -- declaration. The call is inserted after the declaration, but validity
+ -- checks may also have been inserted and thus the initialization call
+ -- does not necessarily appear immediately after the object declaration.
+
+ -- We can't use the freezing mechanism for this purpose, since we have
+ -- to elaborate the initialization expression when it is first seen (so
+ -- this elaboration cannot be deferred to the freeze point).
+
+ -- Find and remove generated initialization call for object, if any
+
+ Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N);
+
+ -- Any default initialization expression should be removed (e.g.
+ -- null defaults for access objects, zero initialization of packed
+ -- bit arrays). Imported objects aren't allowed to have explicit
+ -- initialization, so the expression must have been generated by
+ -- the compiler.
+
+ if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
+ Set_Expression (Parent (Def_Id), Empty);
+ end if;
+ end Undo_Initialization;
+
end Exp_Prag;
Set_Has_Non_Standard_Rep (Base_Type (Arr), True);
Set_Is_Bit_Packed_Array (Base_Type (Arr), True);
Set_Is_Packed (Base_Type (Arr), True);
+
+ -- Make sure that we have the necessary routines to
+ -- implement the packing, and complain now if not.
+
+ declare
+ CS : constant Int := UI_To_Int (Csiz);
+ RE : constant RE_Id := Get_Id (CS);
+
+ begin
+ if RE /= RE_Null
+ and then not RTE_Available (RE)
+ then
+ Error_Msg_CRT
+ ("packing of " & UI_Image (Csiz)
+ & "-bit components",
+ First_Subtype (Etype (Arr)));
+ end if;
+ end;
end if;
end;
end if;
* Aspect Simple_Storage_Pool_Type::
* Aspect SPARK_Mode::
* Aspect Suppress_Debug_Info::
+* Aspect Suppress_Initialization::
* Aspect Test_Case::
* Aspect Thread_Local_Storage::
* Aspect Universal_Aliasing::
Syntax:
@smallexample @c ada
-pragma Suppress_Initialization ([Entity =>] subtype_Name);
+pragma Suppress_Initialization ([Entity =>] variable_or_subtype_Name);
@end smallexample
@noindent
-Here subtype_Name is the name introduced by a type declaration
-or subtype declaration.
-This pragma suppresses any implicit or explicit initialization
+Here variable_or_subtype_Name is the name introduced by a type declaration
+or subtype declaration or the name of a variable introduced by an
+object declaration.
+
+In the case of a type or subtype
+this pragma suppresses any implicit or explicit initialization
for all variables of the given type or subtype,
including initialization resulting from the use of pragmas
Normalize_Scalars or Initialize_Scalars.
overlays or unchecked conversion) to achieve required initialization
of these fields before accessing any object of the corresponding type.
+For the variable case, implicit initialization for the named variable
+is suppressed, just as though its subtype had been given in a pragma
+Suppress_Initialization, as described above.
+
@node Pragma Task_Name
@unnumberedsec Pragma Task_Name
@findex Task_Name
* Aspect Simple_Storage_Pool_Type::
* Aspect SPARK_Mode::
* Aspect Suppress_Debug_Info::
+* Aspect Suppress_Initialization::
* Aspect Test_Case::
* Aspect Thread_Local_Storage::
* Aspect Universal_Aliasing::
@noindent
This boolean aspect is equivalent to pragma @code{Suppress_Debug_Info}.
+@node Aspect Suppress_Initialization
+@unnumberedsec Aspect Suppress_Initialization
+@findex Suppress_Initialization
+@noindent
+This boolean aspect is equivalent to pragma @code{Suppress_Initialization}.
+
@node Aspect Test_Case
@unnumberedsec Aspect Test_Case
@findex Test_Case
-- The field First_Implicit_With in the unit table record are used to
-- avoid creating duplicate with_clauses.
+ ----------------------------------------------
+ -- Table of Predefined RE_Id Error Messages --
+ ----------------------------------------------
+
+ -- If an attempt is made to load an entity, given an RE_Id value, and the
+ -- entity is not available in the current configuration, an error message
+ -- is given (see Entity_Not_Defined below). The general form of such an
+ -- error message is for example:
+
+ -- entity "System.Pack_43.Bits_43" not defined
+
+ -- The following table defines a set of RE_Id image values for which this
+ -- error message is specialized and replaced by specific text indicating
+ -- the exact message to be output. For example, in the case above, for the
+ -- RE_Id value RE_Bits_43, we do indeed specialize the message, and the
+ -- above generic message is replaced by:
+
+ -- packed component size of 43 is not supported
+
+ type CString_Ptr is access constant String;
+
+ type PRE_Id_Entry is record
+ Str : CString_Ptr;
+ -- Pointer to string with the RE_Id image. The sequence ?? may appear
+ -- in which case it will match any characters in the RE_Id image value.
+ -- This is used to avoid the need for dozens of entries for RE_Bits_??.
+
+ Msg : CString_Ptr;
+ -- Pointer to string with the corresponding error text. The sequence
+ -- ?? may appear, in which case, it is replaced by the corresponding
+ -- sequence ?? in the Str value (if the first ? is zero, then it is
+ -- omitted from the message).
+ end record;
+
+ Str1 : aliased constant String := "RE_BITS_??";
+ Str2 : aliased constant String := "RE_GET_??";
+ Str3 : aliased constant String := "RE_SET_??";
+ Str4 : aliased constant String := "RE_CALL_SIMPLE";
+
+ MsgPack : aliased constant String :=
+ "packed component size of ?? is not supported";
+ MsgRV : aliased constant String :=
+ "task rendezvous is not supported";
+
+ PRE_Id_Table : constant array (Natural range <>) of PRE_Id_Entry :=
+ (1 => (Str1'Access, MsgPack'Access),
+ 2 => (Str2'Access, MsgPack'Access),
+ 3 => (Str3'Access, MsgPack'Access),
+ 4 => (Str4'Access, MsgRV'Access));
+ -- We will add entries to this table as we find cases where it is a good
+ -- idea to do so. By no means all the RE_Id values need entries, because
+ -- the expander often gives clear messages before it makes the Rtsfind
+ -- call expecting to find the entity.
+
-----------------------
-- Local Subprograms --
-----------------------
procedure Entity_Not_Defined (Id : RE_Id);
-- Outputs error messages for an entity that is not defined in the run-time
-- library (the form of the error message is tailored for no run time or
- -- configurable run time mode as required).
+ -- configurable run time mode as required). See also table of pre-defined
+ -- messages for entities above (RE_Id_Messages).
function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type;
-- Retrieves the Unit Name given a unit id represented by its enumeration
procedure Output_Entity_Name (Id : RE_Id; Msg : String);
-- Output continuation error message giving qualified name of entity
- -- corresponding to Id, appending the string given by Msg. This call
- -- is only effective in All_Errors mode.
+ -- corresponding to Id, appending the string given by Msg.
function RE_Chars (E : RE_Id) return Name_Id;
-- Given a RE_Id value returns the Chars of the corresponding entity
RTE_Error_Msg ("run-time configuration error");
end if;
+ -- See if this entry is to be found in the PRE_Id table that provides
+ -- specialized messages for some RE_Id values.
+
+ for J in PRE_Id_Table'Range loop
+ declare
+ TStr : constant String := PRE_Id_Table (J).Str.all;
+ RStr : constant String := RE_Id'Image (Id);
+ TMsg : String := PRE_Id_Table (J).Msg.all;
+ LMsg : Natural := TMsg'Length;
+
+ begin
+ if TStr'Length = RStr'Length then
+ for J in TStr'Range loop
+ if TStr (J) /= RStr (J) and then TStr (J) /= '?' then
+ goto Continue;
+ end if;
+ end loop;
+
+ for J in TMsg'First .. TMsg'Last - 1 loop
+ if TMsg (J) = '?' then
+ for K in 1 .. TStr'Last loop
+ if TStr (K) = '?' then
+ if RStr (K) = '0' then
+ TMsg (J) := RStr (K + 1);
+ TMsg (J + 1 .. LMsg - 1) := TMsg (J + 2 .. LMsg);
+ LMsg := LMsg - 1;
+ else
+ TMsg (J .. J + 1) := RStr (K .. K + 1);
+ end if;
+
+ exit;
+ end if;
+ end loop;
+ end if;
+ end loop;
+
+ RTE_Error_Msg (TMsg (1 .. LMsg));
+ return;
+ end if;
+ end;
+
+ <<Continue>> null;
+ end loop;
+
+ -- We did not find an entry in the table, so output the generic entity
+ -- not found message, where the name of the entity corresponds to the
+ -- given RE_Id value.
+
Output_Entity_Name (Id, "not defined");
end Entity_Not_Defined;
Static :=
Static and then not Is_Constr_Subt_For_U_Nominal (P_Type);
Set_Is_Static_Expression (N, Static);
-
end if;
while Present (Nod) loop
if not Is_Static_Subtype (Etype (Nod)) then
Static := False;
Set_Is_Static_Expression (N, False);
+
elsif not Is_OK_Static_Subtype (Etype (Nod)) then
Set_Raises_Constraint_Error (N);
+ Static := False;
+ Set_Is_Static_Expression (N, False);
end if;
-- If however the index type is generic, or derived from
begin
E := E1;
+
while Present (E) loop
-- If expression is not static, then the attribute reference
end loop;
if Raises_Constraint_Error (Prefix (N)) then
+ Set_Is_Static_Expression (N, False);
return;
end if;
end;
E := Entity (E_Id);
- if not Is_Type (E) then
- Error_Pragma_Arg ("pragma% requires type or subtype", Arg1);
+ if not Is_Type (E) and then Ekind (E) /= E_Variable then
+ Error_Pragma_Arg
+ ("pragma% requires variable, type or subtype", Arg1);
end if;
if Rep_Item_Too_Early (E, N)
elsif Is_First_Subtype (E) then
Set_Suppress_Initialization (Base_Type (E));
- -- For other than first subtype, set flag on subtype itself
+ -- For other than first subtype, set flag on subtype or variable
else
Set_Suppress_Initialization (E);
-- the entities within it).
if (Is_Implementation_Defined (Val)
- or else
- Is_Implementation_Defined (Scope (Val)))
+ or else
+ (Present (Scope (Val))
+ and then Is_Implementation_Defined (Scope (Val))))
and then not (Ekind_In (Val, E_Package, E_Generic_Package)
and then Is_Library_Level_Entity (Val))
then
-- --
-- S p e c --
-- --
--- Copyright (C) 2011-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2011-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Examples: ??? add examples here
+ -- -------------------------------
+ -- -- Generated Globals Section --
+ -- -------------------------------
+
+ -- The Generated Globals section is located at the end of the ALI file.
+
+ -- All lines introducing information related to the Generated Globals
+ -- have the string "GG" appearing in the beginning. This string ("GG")
+ -- should therefore not be used in the beginning of any line that does
+ -- not relate to Generated Globals.
+
+ -- The processing (reading and writing) of this section happens in
+ -- package Flow_Computed_Globals (from the SPARK 2014 sources), for
+ -- further information please refer there.
+
----------------
-- Xref Table --
----------------
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Image_Out (Input, True, Format);
end UI_Image;
+ function UI_Image
+ (Input : Uint;
+ Format : UI_Format := Auto) return String
+ is
+ begin
+ Image_Out (Input, True, Format);
+ return UI_Image_Buffer (1 .. UI_Image_Length);
+ end UI_Image;
+
-------------------------
-- UI_Is_In_Int_Range --
-------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- followed by the value in UI_Image_Buffer. The form of the value is an
-- integer literal in either decimal (no base) or hexadecimal (base 16)
-- format. If Hex is True on entry, then hex mode is forced, otherwise
- -- UI_Image makes a guess at which output format is more convenient.
- -- The value must fit in UI_Image_Buffer. If necessary, the result is an
- -- approximation of the proper value, using an exponential format. The
- -- image of No_Uint is output as a single question mark.
+ -- UI_Image makes a guess at which output format is more convenient. The
+ -- value must fit in UI_Image_Buffer. The actual length of the result is
+ -- returned in UI_Image_Length. If necessary to meet this requirement, the
+ -- result is an approximation of the proper value, using an exponential
+ -- format. The image of No_Uint is output as a single question mark.
+
+ function UI_Image (Input : Uint; Format : UI_Format := Auto) return String;
+ -- Functional form, in which the result is returned as a string. This call
+ -- also leaves the result in UI_Image_Buffer/Length as described above.
procedure UI_Write (Input : Uint; Format : UI_Format := Auto);
-- Writes a representation of Uint, consisting of a possible minus sign,
projects / gcc.git / commitdiff