|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 45056 (0xb000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, function Get_Pragma_Info, seg_0508f9, separate Rs6000_Aix_Vads
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
--with Get_Pragmas;
separate (Rs6000_Aix_Vads)
function Get_Pragma_Info return Pragmas.Object is
-- The following pragmas have been implemented. Any limitations in the
-- implementation are included in the comments associated with the
-- pragma involved.
--
-- The details of each pragma's use and functionality are documented in
-- the "IBM RISC System/6000 AIX Version 6.2.1 - Programmer's Guide".
--
-- * --> ADA's predefined pragmas
-- ** --> Previous additional pragmas
-- *** --> New additional pragmas
--
-- Pragma Bit_Pack ***
-- Pragma Built_In *
-- Pragma Byte_Pack ***
-- Pragma Controlled *
-- Pragma Elaborate *
-- Pragma External_Name (see limitations - parameters) **
-- Pragma Implicit_Code (see limitations - parameters) **
-- Pragma Initialize (see limitations - parameters) ***
-- Pragma Inline *
-- Pragma Inline_Only (see limitations) **
-- Pragma Interface (see parameters) *
-- Pragma Interface_Name (see limitations - parameters) **
-- Pragma Link_With (see parameters) **
-- Pragma List *
-- Pragma Local_Access (see parameters) ***
-- Pragma Memory_Size *
-- Pragma No_Image **
-- Pragma Non_Reentrant (see parameters) **
-- Pragma Not_Elaborated (see limitations) **
-- Pragma Optimize *
-- Pragma Optimize_Code (see limitations - parameters) **
-- Pragma Pack *
-- Pragma Page *
-- Pragma Passive (see limitations - parameters) **
-- Pragma Priority *
-- Pragma Remote_Access (see parameters) ***
-- Pragma Rts_Interface (see parameters) **
-- Pragma Share_Body **
-- Pragma Share_Code (see limitations - parameters) *
-- Pragma Shared (see parameters) *
-- Pragma Storage_Unit *
-- Pragma Suppress (see parameters) ***
-- Pragma System_Name *
-- Pragma Task_attributes (see parameters) ***
-- Pragma Volatile (see parameters) **
-- Pragma Warnings (see parameters) ***
-------------------------------------------------------------------------------
-- Declarations used by more than one Pragma definition
All_Types_Allowed : Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => Checking.All_Structural_Types,
Valid_Textual_Types => Checking.No_Type_Names,
Required_Pragmas => Checking.No_Pragmas,
Prohibited_Pragmas => Checking.No_Pragmas,
For_Target => T_Name);
All_Objects_Allowed : constant Checking.Object_Set :=
Checking.Build (Valid_Kinds => Checking.All_Object_Kinds,
Allowed_Types => All_Types_Allowed,
For_Target => T_Name);
Null_Constraint : constant Checking.Range_Constraint :=
Checking.Null_Constraint (For_Target => T_Name);
String_Expression : constant Checking.Expression :=
Checking.Build (Expression_Type => "String",
Constraint => Null_Constraint,
For_Target => T_Name);
On_Off_Argument : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "On_Off",
Valid_Special_Identifiers =>
(Text.Build ("On", T_Name), Text.Build ("Off", T_Name)),
For_Target => T_Name);
On_Off_Arguments : constant Pragmas.Argument_Array :=
(1 => On_Off_Argument);
Link_Name_Arg : constant Pragmas.Argument :=
Pragmas.Build_Expression_Argument
(Name => "Link_Name",
Valid_Expressions => String_Expression,
For_Target => T_Name);
Subprogram_Misc_Names : Checking.Miscellaneous_Name_Set := Checking.Build (Valid_Kinds => (Checking.Function_Kind => True,
Checking.Procedure_Kind => True,
Checking.Generic_Function_Kind => True,
Checking.Generic_Procedure_Kind => True,
others => False),
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Bit_pack ;
--
-- Indicates to the compiler that packing down to the bit level is desired.
-- Bit_pack can be used interchangeably with Pragmas Pack and Byte_pack
Bit_Pack_Arg_Types : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => (Checking.Access_Type => False,
Checking.Task_Type => False,
Checking.Array_Type => False,
Checking.Record_Type => False,
others => True),
For_Target => T_Name);
Bit_Pack_Argument : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument (Name => "Bit_Pack",
Valid_Types => Bit_Pack_Arg_Types,
For_Target => T_Name);
Bit_Pack_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Bit_pack",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => (1 => Bit_Pack_Argument),
Last_Required_Argument => 0,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Byte_pack ;
--
-- Indicates to the compiler that packing down to the byte level is desired
-- Byte_pack can be used interchangeably with Pragmas Pack and Bit_pack
Byte_Pack_Arg_Types : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => (Checking.Access_Type => False,
Checking.Task_Type => False,
Checking.Array_Type => False,
Checking.Record_Type => False,
others => True),
For_Target => T_Name);
Byte_Pack_Argument : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument (Name => "Bit_Pack",
Valid_Types => Byte_Pack_Arg_Types,
For_Target => T_Name);
Byte_Pack_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Byte_pack",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => (1 => Byte_Pack_Argument),
Last_Required_Argument => 0,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma External_Name (Subprogram or Ada Variable,"Link_Name")
--
-- Allow the user to specify a link for Ada variable or subprogram so that
-- the object can be referenced from other languages.
-- This Pragma is allowed at the place of a declarative specification and
-- must apply to an object declared earlier in the same package.
-- This Pragma is allowed with INLINE subprograms, but disallowed with
-- INLINE_ONLY subprograms.
External_Name_Objects : Checking.Object_Set :=
Checking.Build (Valid_Kinds =>
(Checking.Variable => True, others => False),
Allowed_Types => All_Types_Allowed,
For_Target => T_Name);
External_Name_Misc_Names : Checking.Miscellaneous_Name_Set :=
Checking.Build (Valid_Kinds => (Checking.Function_Kind => True,
Checking.Procedure_Kind => True,
others => False),
Ambiguity_Allowed => False,
For_Target => T_Name);
External_Name_Arg_1 : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "Ada_Name",
Valid_Objects => External_Name_Objects,
Valid_Miscellaneous_Names => External_Name_Misc_Names,
For_Target => T_Name);
External_Name_Arguments : constant Pragmas.Argument_Array :=
(External_Name_Arg_1, Link_Name_Arg);
External_Name_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "External_Name",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => External_Name_Arguments,
Last_Required_Argument => 2,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Implicit_Code (On)
-- Pragma Implicit_Code (Off)
--
-- Specifies that implicit code generated by the compiler is allowed (ON)
-- or disallowed (OFF).
-- Allowed only in the declarative part of a machine code
-- procedure. No way to really enforce this.
Implicit_Code_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Implicit_Code",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => On_Off_Arguments,
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Initialize (Static)
-- Pragma Initialize (Dynamic)
--
-- When placed in a library_level package, spec or body; Causes all objects
-- in the package to be initialized as indicated, statically or dynamically.
-- Only library_level objects are subjects to static initialization.
-- All objects within procedures are, by definition, dynamic
Initialize_Arguments : constant Pragmas.Argument_Array :=
(1 => Pragmas.Build_Name_Argument
(Name => "Static or Dynamic",
Valid_Objects => Checking.Null_Object_Set,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Checking.Null_Type_Set,
Valid_Special_Identifiers =>
(Text.Build (S => "Dynamic", For_Target => T_Name),
Text.Build (S => "Static", For_Target => T_Name)),
For_Target => T_Name));
Initialize_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Initialize",
Valid_Locations =>
(Pragmas.Comp_Unit => True, others => False),
Arguments => Initialize_Arguments,
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Inline_Only
--
-- Used in the same manner as Pragma INLINE, refer Appendix B of the
-- Ada RM. This implementation arbitrarily limits the number of arguments
-- to 5, but the Ibm Ada documentation imposes no limitation. If more
-- than 5 parameters are supplied, the semanticist will only issue a
-- warning, but the code will still install.
Inline_Only_Arg_1 : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "Ada_Subprogram_Name",
Valid_Objects => Checking.Null_Object_Set,
Valid_Miscellaneous_Names => Subprogram_Misc_Names,
For_Target => T_Name);
Inline_Only_Arguments : constant Pragmas.Argument_Array :=
(1 => Inline_Only_Arg_1,
2 => Inline_Only_Arg_1,
3 => Inline_Only_Arg_1,
4 => Inline_Only_Arg_1,
5 => Inline_Only_Arg_1);
Inline_Only_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Inline_Only",
Valid_Locations => (Pragmas.Comp_Unit => True,
Pragmas.Declaration => True,
others => False),
Arguments => Inline_Only_Arguments,
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Interface_Name (Ada_Name,"Link_Name")
--
-- Allows variables or subprograms defined in another language to be
-- referenced directly in Ada.
-- Allowed only in declarative portion of a package spec. If applied to
-- an object, must be scalar or Access Type and cannot be loop
-- variable, constant, initialized_variable, array or record. If
-- applied to a subprogram, a Pragma INTERFACE must have already been
-- specified for the subprogram. It may not be possible to correctly
-- enforce these restrictions.
Interface_Name_Allowed_Types : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => (Checking.Array_Type => False,
Checking.Record_Type => False,
Checking.Task_Type => False,
others => True),
For_Target => T_Name);
Interface_Name_Objects : Checking.Object_Set :=
Checking.Build (Valid_Kinds =>
(Checking.Variable => True, others => False),
Allowed_Types => Interface_Name_Allowed_Types,
For_Target => T_Name);
Interface_Name_Required_Pragmas : constant Checking.Pragma_Array :=
(1 => Text.Build (S => "Interface", For_Target => T_Name));
Interface_Name_Misc_Names : Checking.Miscellaneous_Name_Set :=
Checking.Build (Valid_Kinds => (Checking.Function_Kind => True,
Checking.Procedure_Kind => True,
others => False),
Ambiguity_Allowed => False,
Required_Pragmas => Interface_Name_Required_Pragmas,
For_Target => T_Name);
Interface_Name_Arg_1 : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "Ada_Name",
Valid_Objects => Interface_Name_Objects,
Valid_Miscellaneous_Names => Interface_Name_Misc_Names,
For_Target => T_Name);
Interface_Name_Arguments : constant Pragmas.Argument_Array :=
(Interface_Name_Arg_1, Link_Name_Arg);
Interface_Name_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Interface_Name",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => Interface_Name_Arguments,
Last_Required_Argument => 2,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Link_With ("Linker_Argument");
--
-- Used to pass arguments to a target linker
Link_With_Argument : constant Pragmas.Argument :=
Pragmas.Build_Expression_Argument
(Name => "Linker_Option",
Valid_Expressions => String_Expression,
For_Target => T_Name);
Link_With_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Link_With",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => (1 => Link_With_Argument),
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Local_access
-- Pragma Local_access (Access_type)
--
-- Is meaningfull only in Distributed Ada (DADS) products; it has no effect
-- when using a standard VADS compiler.
-- It causes access value to be local pointers.
Local_Access_Allowed_Types : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types =>
(Checking.Access_Type => True, others => False),
For_Target => T_Name);
Local_Access_Objects : Checking.Object_Set :=
Checking.Build (Valid_Kinds => Checking.No_Object_Kinds,
Allowed_Types => Local_Access_Allowed_Types,
For_Target => T_Name);
Local_Access_Arguments : constant Pragmas.Argument_Array :=
(1 => Pragmas.Build_Name_Argument
(Name => "Local_Access",
Valid_Objects => Local_Access_Objects,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Checking.Null_Type_Set,
For_Target => T_Name));
Local_Access_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Local_Access",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => Local_Access_Arguments,
Last_Required_Argument => 0,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma No_Image (Type_Name);
--
-- Suppressed the generation of the image array used for the IMAGE
-- attribute of enumeration type.
No_Image_Arg_Types : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types =>
(Checking.Enumeration_Type => True, others => False),
For_Target => T_Name);
No_Image_Argument : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument (Name => "No_Image",
Valid_Types => No_Image_Arg_Types,
For_Target => T_Name);
No_Image_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "No_Image",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => (1 => No_Image_Argument),
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Non_Reentrant (Ada_Subprogram_Name)
--
-- Indicates to the compliler that the subprogram is not called
-- recursively allowing the compiler to perform specific optimizations
Non_Reentrant_Arg : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "Ada_Subprogram_Name",
Valid_Objects => Checking.Null_Object_Set,
Valid_Miscellaneous_Names => Subprogram_Misc_Names,
For_Target => T_Name);
Non_Reentrant_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Non_Reentrant",
Valid_Locations => (Pragmas.Comp_Unit => True,
Pragmas.Declaration => True,
others => False),
Arguments => (1 => Non_Reentrant_Arg),
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Not_Elaborated
-- Can appear only in a package spec.
--
-- Valid_Locations is currently limited in its ability to limit where a
-- Pragma may appear. It is up to the user to properly locate the
-- Pragma.
Not_Elaborated_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Not_Elaborated",
Valid_Locations => (Pragmas.Comp_Unit => True,
Pragmas.Declaration => True,
others => False),
Arguments => Pragmas.No_Arguments,
Last_Required_Argument => 0,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Optimize_Code (On)
-- Pragma Optimize_Code (Off)
-- May appear in any subprogram. Default is ON.
--
-- Valid_Locations is currently limited in its ability to limit where a
-- Pragma may appear. It is up to the user to properly locate the
-- Pragma.
Optimize_Code_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Optimize_Code",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => On_Off_Arguments,
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Pack;
--
-- Causes the compiler to minimize gaps between components in the
-- representation of composite types.
Pack_Arg_Types : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => (Checking.Access_Type => False,
Checking.Task_Type => False,
Checking.Array_Type => False,
Checking.Record_Type => False,
others => True),
For_Target => T_Name);
Pack_Argument : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "Pack", Valid_Types => Pack_Arg_Types, For_Target => T_Name);
Pack_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Pack",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => (1 => Pack_Argument),
Last_Required_Argument => 0,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Passive
-- Pragma Passive (Abort_Safe);
-- Pragma Passive (Abort_Unsafe);
-- Pragma Passive (Abort_Safe, mutex_attr'address))
-- Pragma Passive (Abort_Unsafe, mutex_attr'address)
--
-- Because there are four valid forms of the Pragma, the code below
-- allows the user to successfully semanticize all four. However,
-- improper combinations will also semanticize on the R1000
-- It is up to the user to use the Pragma correctly.
--
-- Pragma can only be applied to a task or task type declared
-- immediately within a package spec or body.
--
-- Valid_Locations is currently limited in its ability to limit where a
-- Pragma may appear. It is up to the user to properly locate the
-- Pragma.
Passive_Allowed_Types : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => Checking.No_Structural_Types,
Valid_Textual_Types =>
(1 => Text.Build (S => "System.Address",
For_Target => T_Name)),
For_Target => T_Name);
Passive_Objects : Checking.Object_Set :=
Checking.Build (Valid_Kinds => Checking.All_Object_Kinds,
Allowed_Types => Passive_Allowed_Types,
For_Target => T_Name);
Passive_Arguments : constant Pragmas.Argument_Array :=
(1 => Pragmas.Build_Name_Argument
(Name => "Abort_Safe_or_Unsafe",
Valid_Objects => Checking.Null_Object_Set,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Checking.Null_Type_Set,
Valid_Special_Identifiers =>
(Text.Build (S => "Abort_Safe", For_Target => T_Name),
Text.Build (S => "Abort_Unsafe", For_Target => T_Name)),
For_Target => T_Name),
2 => Pragmas.Build_Name_Argument
(Name => "Task_Address",
Valid_Objects => Passive_Objects,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Passive_Allowed_Types,
Valid_Special_Identifiers => Checking.No_Identifiers,
For_Target => T_Name));
Passive_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Passive",
Valid_Locations =>
(Pragmas.Task_Spec => True, others => False),
Arguments => Passive_Arguments,
Last_Required_Argument => 0,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Remote_access (Access_type)
--
-- Is meaningfull only in Distributed Ada (DADS) products; it has no effect
-- when using a standard VADS compiler.
-- It causes access value to be traited as a long pointer
Remote_Access_Allowed_Types : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types =>
(Checking.Access_Type => True, others => False),
For_Target => T_Name);
Remote_Access_Objects : Checking.Object_Set :=
Checking.Build (Valid_Kinds => Checking.No_Object_Kinds,
Allowed_Types => Remote_Access_Allowed_Types,
For_Target => T_Name);
Remote_Access_Arguments : constant Pragmas.Argument_Array :=
(1 => Pragmas.Build_Name_Argument
(Name => "Remote_Access",
Valid_Objects => Remote_Access_Objects,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Checking.Null_Type_Set,
For_Target => T_Name));
Remote_Access_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Remote_Access",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => Remote_Access_Arguments,
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Share_Body (Generic_Unit_Name,True)
-- Pragma Share_Body (Generic_Unit_Name,False)
--
-- Pragma Share_Code (Generic_Unit_Name,True)
-- Pragma Share_Code (Generic_Unit_Name,False)
--
-- Share_Body and Share_Code are identical.
--
-- This Pragma may be applied to EITHER a generic unit OR to an
-- an instanitation of a generic unit. We can only check for the
-- former. Therefore, the use of this Pragma applied to an
-- instantiation will cause the R1000 to generate a compiler warning
-- that may be ignored.
Share_Code_Misc_Names : Checking.Miscellaneous_Name_Set :=
Checking.Build (Valid_Kinds => (Checking.Generic_Package_Kind => True,
Checking.Generic_Procedure_Kind => True,
Checking.Generic_Function_Kind => True,
Checking.Package_Kind => True,
Checking.Procedure_Kind => True,
Checking.Function_Kind => True,
others => False),
Ambiguity_Allowed => False,
For_Target => T_Name);
Share_Code_Arguments : constant Pragmas.Argument_Array :=
(1 => Pragmas.Build_Name_Argument
(Name => "Generic_Unit_Or_Instantiation",
Valid_Objects => Checking.Null_Object_Set,
Valid_Miscellaneous_Names => Share_Code_Misc_Names,
For_Target => T_Name),
2 => Pragmas.Build_Name_Argument
(Name => "True_False",
Valid_Special_Identifiers =>
(Text.Build ("True", T_Name), Text.Build ("False", T_Name)),
For_Target => T_Name));
Share_Body_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Share_Body",
Valid_Locations => (Pragmas.Context_Clause => False,
Pragmas.Statement => False,
others => True),
Arguments => Share_Code_Arguments,
Last_Required_Argument => 2,
For_Target => T_Name);
Share_Code_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Share_Code",
Valid_Locations => (Pragmas.Context_Clause => False,
Pragmas.Statement => False,
others => True),
Arguments => Share_Code_Arguments,
Last_Required_Argument => 2,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Suppress (Identifier);
-- Pragma Suppress (Identifier, [ON =>] name)
--
-- The presence of a Suppress pragma gives permission to an implementation
-- to omit a certain runtime check.
-- The identifier is that of the check that can be omitted.
-- The name (if present) must be either a simple name or an expended name
-- and it must denote either an object, a type or subtype, a task unit or
-- a generic unit;
Suppress_Allowed_Types : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => Checking.All_Structural_Types,
For_Target => T_Name);
Suppress_Misc_Names : Checking.Miscellaneous_Name_Set :=
Checking.Build (Valid_Kinds =>
(Checking.Task_Kind => True,
Checking.Generic_Package_Kind => True,
Checking.Generic_Procedure_Kind => True,
Checking.Generic_Function_Kind => True,
Checking.Generic_Formal_Procedure => True,
Checking.Generic_Formal_Function => True,
others => False),
Ambiguity_Allowed => False,
Required_Pragmas => Checking.No_Pragmas,
For_Target => T_Name);
Suppress_Objects : Checking.Object_Set :=
Checking.Build (Valid_Kinds => Checking.All_Object_Kinds,
Allowed_Types => Suppress_Allowed_Types,
For_Target => T_Name);
Suppress_Arguments : constant Pragmas.Argument_Array :=
(1 => Pragmas.Build_Name_Argument
(Name => "Identifier",
Valid_Objects => Checking.Null_Object_Set,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Checking.Null_Type_Set,
Valid_Special_Identifiers =>
(Text.Build (S => "Access_Check", For_Target => T_Name),
Text.Build (S => "All_Checks", For_Target => T_Name),
Text.Build (S => "Discriminant_Check",
For_Target => T_Name),
Text.Build (S => "Division_Check", For_Target => T_Name),
Text.Build (S => "Elaboration_Check",
For_Target => T_Name),
Text.Build (S => "Exception_tables", For_Target => T_Name),
Text.Build (S => "Index_Check", For_Target => T_Name),
Text.Build (S => "Length_Check", For_Target => T_Name),
Text.Build (S => "Overflow_Check", For_Target => T_Name),
Text.Build (S => "Range_Check", For_Target => T_Name),
Text.Build (S => "Storage_Check", For_Target => T_Name)),
For_Target => T_Name),
2 => Pragmas.Build_Name_Argument
(Name => "Name",
Valid_Objects => Suppress_Objects,
Valid_Miscellaneous_Names => Suppress_Misc_Names,
Valid_Types => Suppress_Allowed_Types,
Valid_Special_Identifiers => Checking.No_Identifiers,
For_Target => T_Name));
Suppress_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Suppress",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => Suppress_Arguments,
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Task_Attributes (Task_Attributes'Address)
-- Pragma Task_Attributes (Task_Object, Task_Attributes'Address)
--
-- The first form is only allowed within the specification of a task unit.
-- It specifies the attributes of the task or tasks of the task type
-- The 2nd form is applicable to any task object. It takes precedence
-- over the task attributes specified for the task type.
Task_Attributes_Allowed_Types_1 : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types =>
(Checking.Task_Type => True, others => False),
For_Target => T_Name);
Task_Attributes_Allowed_Types_2 : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => Checking.No_Structural_Types,
Valid_Textual_Types =>
(1 => Text.Build (S => "System.Address",
For_Target => T_Name)),
For_Target => T_Name);
Task_Attributes_Objects_1 : Checking.Object_Set :=
Checking.Build (Valid_Kinds => Checking.No_Object_Kinds,
Allowed_Types => Task_Attributes_Allowed_Types_1,
For_Target => T_Name);
Task_Attributes_Objects_2 : Checking.Object_Set :=
Checking.Build (Valid_Kinds => Checking.All_Object_Kinds,
Allowed_Types => Task_Attributes_Allowed_Types_2,
For_Target => T_Name);
Task_Attributes_Arguments : constant Pragmas.Argument_Array :=
(1 => Pragmas.Build_Name_Argument
(Name => "Task_Object",
Valid_Objects => Task_Attributes_Objects_1,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Checking.Null_Type_Set,
Valid_Special_Identifiers => Checking.No_Identifiers,
For_Target => T_Name),
2 => Pragmas.Build_Name_Argument
(Name => "Task_Attributes_Address",
Valid_Objects => Task_Attributes_Objects_2,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Task_Attributes_Allowed_Types_2,
Valid_Special_Identifiers => Checking.No_Identifiers,
For_Target => T_Name));
Task_Attributes_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Task_Attributes",
Valid_Locations =>
(Pragmas.Task_Spec => True, others => False),
Arguments => Passive_Arguments,
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Volatile (Object_Name)
--
-- Guarantees that loads and stores of the named object are performed as
-- expected after optimization
Volatile_Argument : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument (Name => "Volatile_Object",
Valid_Objects => All_Objects_Allowed,
For_Target => T_Name);
Volatile_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Volatile",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => (1 => Volatile_Argument),
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- Pragma Warnings (On)
-- Pragma Warnings (Off)
--
-- Selectively suppresses warnings on a single statement or a group of
-- statements. Can be located everywhere.
-- No way to really enforce this.
Warnings_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Warnings",
Valid_Locations => (others => True), Arguments => On_Off_Arguments,
Last_Required_Argument => 1,
For_Target => T_Name);
-------------------------------------------------------------------------------
-- The above definitions are used to create the following structures
-------------------------------------------------------------------------------
Implementation_Dependent_Pragmas : constant Pragmas.Target_Pragma_Array :=
(Bit_Pack_Pragma, Byte_Pack_Pragma, External_Name_Pragma,
Implicit_Code_Pragma, Initialize_Pragma, Inline_Only_Pragma,
Interface_Name_Pragma, Link_With_Pragma, Local_Access_Pragma,
No_Image_Pragma, Non_Reentrant_Pragma, Not_Elaborated_Pragma,
Optimize_Code_Pragma, Passive_Pragma, Remote_Access_Pragma,
Share_Body_Pragma, Share_Code_Pragma, Suppress_Pragma,
Task_Attributes_Pragma, Volatile_Pragma, Warnings_Pragma);
Lrm_Defined_Pragmas : constant Pragmas.Ada_Pragma_Array := (others => True);
Pragma_Object : constant Pragmas.Object :=
Pragmas.Build (Supported_Ada_Pragmas => Lrm_Defined_Pragmas,
Target_Pragmas => Implementation_Dependent_Pragmas,
Interface_Languages =>
(1 => Text.Build ("C", T_Name),
2 => Text.Build ("Ada", T_Name),
3 => Text.Build ("FORTRAN", T_Name),
4 => Text.Build ("Pascal", T_Name),
5 => Text.Build ("Unchecked", T_Name)),
For_Target => T_Name);
begin
return Pragma_Object;
-- return Get_Pragmas (T_Name);
end Get_Pragma_Info;
nblk1=2b
nid=0
hdr6=56
[0x00] rec0=18 rec1=00 rec2=01 rec3=06e
[0x01] rec0=0e rec1=00 rec2=02 rec3=084
[0x02] rec0=0f rec1=00 rec2=03 rec3=010
[0x03] rec0=14 rec1=00 rec2=04 rec3=048
[0x04] rec0=1c rec1=00 rec2=05 rec3=002
[0x05] rec0=15 rec1=00 rec2=06 rec3=066
[0x06] rec0=14 rec1=00 rec2=07 rec3=07e
[0x07] rec0=14 rec1=00 rec2=08 rec3=072
[0x08] rec0=16 rec1=00 rec2=09 rec3=00e
[0x09] rec0=18 rec1=00 rec2=0a rec3=04a
[0x0a] rec0=1a rec1=00 rec2=0b rec3=038
[0x0b] rec0=17 rec1=00 rec2=0c rec3=022
[0x0c] rec0=17 rec1=00 rec2=0d rec3=00e
[0x0d] rec0=16 rec1=00 rec2=0e rec3=03e
[0x0e] rec0=17 rec1=00 rec2=0f rec3=02e
[0x0f] rec0=15 rec1=00 rec2=10 rec3=036
[0x10] rec0=17 rec1=00 rec2=11 rec3=026
[0x11] rec0=1c rec1=00 rec2=12 rec3=034
[0x12] rec0=18 rec1=00 rec2=13 rec3=032
[0x13] rec0=18 rec1=00 rec2=14 rec3=022
[0x14] rec0=17 rec1=00 rec2=15 rec3=00c
[0x15] rec0=16 rec1=00 rec2=16 rec3=00a
[0x16] rec0=17 rec1=00 rec2=17 rec3=07c
[0x17] rec0=17 rec1=00 rec2=18 rec3=046
[0x18] rec0=17 rec1=00 rec2=19 rec3=02e
[0x19] rec0=14 rec1=00 rec2=1a rec3=09c
[0x1a] rec0=16 rec1=00 rec2=1b rec3=046
[0x1b] rec0=17 rec1=00 rec2=1c rec3=052
[0x1c] rec0=17 rec1=00 rec2=1d rec3=06a
[0x1d] rec0=1a rec1=00 rec2=1e rec3=034
[0x1e] rec0=11 rec1=00 rec2=1f rec3=04a
[0x1f] rec0=14 rec1=00 rec2=20 rec3=028
[0x20] rec0=15 rec1=00 rec2=21 rec3=068
[0x21] rec0=13 rec1=00 rec2=22 rec3=056
[0x22] rec0=15 rec1=00 rec2=23 rec3=014
[0x23] rec0=0f rec1=00 rec2=24 rec3=05c
[0x24] rec0=18 rec1=00 rec2=25 rec3=044
[0x25] rec0=12 rec1=00 rec2=26 rec3=080
[0x26] rec0=14 rec1=00 rec2=27 rec3=05a
[0x27] rec0=19 rec1=00 rec2=28 rec3=004
[0x28] rec0=19 rec1=00 rec2=29 rec3=002
[0x29] rec0=12 rec1=00 rec2=2a rec3=058
[0x2a] rec0=12 rec1=00 rec2=2b rec3=000
tail 0x21757f458878e74753f52 0x42a00088462060003