DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ T V

⟦ced76208b⟧ TextFile

    Length: 48748 (0xbe6c)
    Types: TextFile
    Names: »V«

Derivation

└─⟦5829e5ed5⟧ Bits:30000534 8mm tape, Rational 1000, RCI 2_0_5
    └─ ⟦c9a165082⟧ »DATA« 
        └─⟦c3895f76e⟧ 
            └─⟦this⟧ 

TextFile

with Simple_Status;
with Universal;
pragma Private_Eyes_Only;
with Eniversal;

package Semantic_Characteristics is

    subtype Target_Id is Natural range 0 .. 256;

    Invalid_Access : exception;
    -- Get on something never built
    -- Raised for access of nonexistant variant field

    Target_Is_Registered : exception;

    Target_Not_Initialized : exception;

    package Text is
        type Item is private;
        function Build (S : String; For_Target : String) return Item;
        function Get (T : Item) return String;

        type List is array (Positive range <>) of Item;
    private
        type Item is access String;
        pragma Segmented_Heap (Item);
    end Text;

----------------------------------------------------------------------

-- Type checking
    package Checking is

        type Structural_Type_Kind is
           (Access_Type, Array_Type, Enumeration_Type, Integer_Type,
            Fixed_Point_Type, Floating_Point_Type, Formal_Discrete_Type,
            Formal_Fixed_Type, Formal_Float_Type, Formal_Integer_Type,
            Record_Type, Task_Type, Universal_Integer_Type,
            Universal_Fixed_Type, Universal_Real_Type);

        type Type_Restriction_Kind is
           (No_Subtypes, No_Private_Types,
            No_Limited_Private_Types, No_Derived_Types);
        -- Future ideas: Constraints, discrims, dif decl parts,
        --              ambiguous names, etc.

        type Structural_Type_Array is array (Structural_Type_Kind) of Boolean;

        All_Structural_Types :
           constant Structural_Type_Array := (others => True);
        No_Structural_Types : constant Structural_Type_Array :=
           (others => False);

        type Type_Restriction_Array is array (Type_Restriction_Kind) of Boolean;

        All_Type_Restrictions :
           constant Type_Restriction_Array := (others => True);
        No_Type_Restrictions :
           constant Type_Restriction_Array := (others => False);

        subtype Type_Name is String;
        -- For universal_integer use "universal_integer", not
        -- "Standard.universal_integer" or anything else.

        subtype Type_Name_Array is Text.List;
        No_Type_Names : Type_Name_Array (1 .. 0);

        subtype Pragma_Array is Text.List;
        No_Pragmas : Pragma_Array (1 .. 0);

        ----------
        type Type_Set is private;

        -- A type_set describes the valid type names for a given
        -- argument.
        --       eg.  In the statement 'pragma foo (<bar>);', where <bar>
        --      names a type,  a type_set would be used in the description of
        --      pragma 'foo' to describe what kind of type <bar> can be.
        -- Type_sets are NOT used to represent the types of expressions.

        -- Type sets consist of the following.
        --
        -- Enforced_Type_Restrictions:
        --          Miscellaneous restrictions about non-structural
        --          aspects of the type.
        --
        -- Valid_Structural_Types:
        --          Which general structural categories are allowed.
        --          (Record, array, Access, etc).
        --          This is ignored if the type under consideration matches
        --          one of the 'Valid_Textual_Types'.
        --
        -- Valid_Textual_Types:
        --          A list of the names of SPECIFIC types that are allowed for
        --          an argument.  eg "Integer", "System.Address",
        --          "Text_Io.Count".  Only types from predefined units are
        --          allowed.  Visibility to package Standard is implicit so
        --          it is not necessary to say "Standard.Character" as
        --          "Character" will suffice.
        --          Note that Enforced_type_restrictions must hold when the type
        --          under consideration is derived in some manner from one
        --          of the Valid_Textual_Types, but do not apply to the textual
        --          type itself.
        --              eg.  if the 'no_derived_types' restriction is present,
        --              and "System.Address" is a valid_textual_type, then

        --                  type T is new System.Address;
        --                  pragma Foo (T);

        --              is rejected, but

        --                  pragma Foo (System.Address);

        --              and

        --                  subtype T is System.Address;
        --                  pragma Foo (T);

        --              are not, REGARDLESS of whether System.Address is
        --              a derived type.
        --
        -- Required_Pragmas and Prohibited_Pragmas are pragmas that must or
        -- must not be applied to the type under consideration to make it
        -- legal.  Again, this check is not made on any of the
        -- 'Valid_Textual_Types' or its ancestors.

        function Null_Type_Set return Type_Set;
        -- A null type_set means no types are allowed

        function Is_Null (The_Type_Set : Type_Set) return Boolean;

        function Build (Enforced_Type_Restrictions : Type_Restriction_Array;
                        Valid_Structural_Types : Structural_Type_Array;
                        Valid_Textual_Types : Type_Name_Array :=
                           Checking.No_Type_Names;
                        Required_Pragmas : Pragma_Array := Checking.No_Pragmas;
                        Prohibited_Pragmas : Pragma_Array :=
                           Checking.No_Pragmas;
                        For_Target : String) return Type_Set;

        function Get_Enforced_Type_Restrictions
                    (The_Type_Set : Type_Set) return Type_Restriction_Array;
        function Get_Valid_Structural_Types
                    (The_Type_Set : Type_Set) return Structural_Type_Array;
        function Get_Valid_Textual_Types
                    (The_Type_Set : Type_Set) return Type_Name_Array;
        function Get_Required_Pragmas
                    (The_Type_Set : Type_Set) return Pragma_Array;
        function Get_Prohibited_Pragmas
                    (The_Type_Set : Type_Set) return Pragma_Array;

----------------------------------------------------------------------
-- expressions

        type Expression_Form is (Integer_Form, Real_Form, Other_Form);

        ----------------------------------------------------------------------
        -- expression description

        ----------
        type Range_Data is private;
        -- Range_data is for scalar expressions that must be static and must
        -- lie within known bounds.
        --  Expressions that can be non-static or are not scalar base types
        -- should use build_no_range.
        --

        function Build_Integer_Range
                    (Lo, Hi : Universal.Integer; For_Target : String)
                    return Range_Data;
        function Build_Real_Range
                    (Lo, Hi : Universal.Float; For_Target : String)
                    return Range_Data;
        function Build_No_Range (For_Target : String) return Range_Data;

        function Get_Expression_Form
                    (The_Range_Data : Range_Data) return Expression_Form;

        function Get_Integer_Lo (The_Range_Data : Range_Data)
                                return Universal.Integer;
        function Get_Integer_Hi (The_Range_Data : Range_Data)
                                return Universal.Integer;
        function Get_Real_Lo (The_Range_Data : Range_Data)
                             return Universal.Float;
        function Get_Real_Hi (The_Range_Data : Range_Data)
                             return Universal.Float;

        ----------
        type Range_Constraint is private;

        function Is_Null
                    (The_Range_Constraint : Range_Constraint) return Boolean;

        function Build_With_Static_Range
                    (The_Range_Data : Range_Data; For_Target : String)
                    return Range_Constraint;

        function Null_Constraint (For_Target : String) return Range_Constraint;

        -- A null range_constraint is just a range built with build_no_range.
        -- Use for non-scalar or non-static expressions.

        function Get_Must_Be_Static
                    (The_Range_Constraint : Range_Constraint) return Boolean;
        function Get_Range_Data
                    (The_Range_Constraint : Range_Constraint) return Range_Data;


        ----------
        type Expression is private;

        -- An abstract expression represents an set of valid ada expressions.
        -- The components consist of the type of the expression and a
        -- constraint if any.  If expression is static and violates the
        -- bounds of the expression type itself, a warning will be produced
        -- regardless of the presence or absence of the 'constraint'
        -- component.
        -- A null expression does not mean no expressions are allowed, it
        -- means that no information is available about the set of allowed
        -- expressions and thus ALL expressions are allowed.

        function Null_Expression return Expression;

        function Is_Null (The_Expression : Expression) return Boolean;

        function Build (Expression_Type : Type_Name;
                        Constraint : Range_Constraint;
                        For_Target : String) return Expression;

        function Get_Expression_Type
                    (The_Expression : Expression) return Type_Name;
        function Get_Constraint (The_Expression : Expression)
                                return Range_Constraint;

----------------------------------------------------------------------
        -- Identifiers

        subtype Identifier_Array is Text.List;

        No_Identifiers : Identifier_Array (1 .. 0);
        All_Special_Identifiers : Identifier_Array (1 .. -1);

----------------------------------------------------------------------
-- Object checking

        type Object_Kind is (Constant_Kind, Discriminant, In_Out_Parameter,
                             In_Parameter, Iteration_Variable,
                             Named_Number, Out_Parameter, Variable);

        type Miscellaneous_Name_Kind is
           (Function_Kind, Package_Kind, Procedure_Kind, Task_Kind,
            Entry_Kind, Exception_Kind, Enumeration_Literal_Kind,
            Record_Component_Kind, Generic_Package_Kind, Generic_Procedure_Kind,
            Generic_Function_Kind, Generic_Formal_Procedure,
            Generic_Formal_Function, Label_Kind, Named_Statement_Kind);

        type Object_Kind_Array is array (Object_Kind) of Boolean;

        No_Object_Kinds : constant Object_Kind_Array := (others => False);
        All_Object_Kinds : constant Object_Kind_Array := (others => True);

        type Miscellaneous_Name_Kind_Array is
           array (Miscellaneous_Name_Kind) of Boolean;
        No_Miscellaneous_Name_Kinds :
           constant Miscellaneous_Name_Kind_Array := (others => False);
        All_Miscellaneous_Name_Kinds :
           constant Miscellaneous_Name_Kind_Array := (others => True);


        ----------
        type Object_Set is private;

        -- An object_set describes the allowed ada object names for a given
        -- argument.  Object_sets are NOT used to describe expressions, even
        -- though objects can be expressions.
        -- The components of an object_set are the following:
        -- Valid_Kinds:
        --      What forms of objects are allowed,
        --          (Constants, Named_Numbers, out parameters, etc.)
        -- Allowed_Types
        --      Which types can the object have.
        -- Required and Prohibited Pragmas
        --      Which pragmas must or must not be applied to the object.
        --

        function Null_Object_Set return Object_Set;

        -- A null object_set means no objects are allowed

        function Is_Null (The_Object_Set : Object_Set) return Boolean;

        function Build (Valid_Kinds : Object_Kind_Array;
                        Allowed_Types : Type_Set;
                        Required_Pragmas : Pragma_Array := Checking.No_Pragmas;
                        Prohibited_Pragmas : Pragma_Array :=
                           Checking.No_Pragmas;
                        For_Target : String) return Object_Set;

        function Get_Valid_Kinds (The_Object_Set : Object_Set)
                                 return Object_Kind_Array;
        function Get_Allowed_Types
                    (The_Object_Set : Object_Set) return Type_Set;
        function Get_Required_Pragmas
                    (The_Object_Set : Object_Set) return Pragma_Array;
        function Get_Prohibited_Pragmas
                    (The_Object_Set : Object_Set) return Pragma_Array;

        ----------
        type Miscellaneous_Name_Set is private;

        -- Miscellaneous_Name_Sets are used to describe ada names other than
        -- types or objects.  (Such as functions, exceptions, and generics).
        -- Note that since enumeration_literals, functions, procedures,
        -- and entries can be overloaded, some miscellaneous names are
        -- ambiguous.  The ambiguity_allowed component of a miscellaneous_
        -- name_set denotes whether an ambiguous name can be used for the
        -- given argument.

        function Null_Miscellaneous_Name_Set return Miscellaneous_Name_Set;

        -- A null miscellaneous_name_set means no miscellaneous names are
        -- allowed.

        function Is_Null (The_Miscellaneous_Name_Set : Miscellaneous_Name_Set)
                         return Boolean;

        function Build (Valid_Kinds : Miscellaneous_Name_Kind_Array;
                        Ambiguity_Allowed : Boolean := True;
                        Required_Pragmas : Pragma_Array := Checking.No_Pragmas;
                        Prohibited_Pragmas : Pragma_Array :=
                           Checking.No_Pragmas;
                        For_Target : String) return Miscellaneous_Name_Set;

        function Ambiguity_Allowed
                    (The_Miscellaneous_Name_Set : Miscellaneous_Name_Set)
                    return Boolean;
        function Get_Valid_Kinds
                    (The_Miscellaneous_Name_Set : Miscellaneous_Name_Set)
                    return Miscellaneous_Name_Kind_Array;
        function Get_Required_Pragmas
                    (The_Miscellaneous_Name_Set : Miscellaneous_Name_Set)
                    return Pragma_Array;
        function Get_Prohibited_Pragmas
                    (The_Miscellaneous_Name_Set : Miscellaneous_Name_Set)
                    return Pragma_Array;

    private
        type Pragma_Array_Ptr is access Pragma_Array;
        pragma Segmented_Heap (Pragma_Array_Ptr);
        type Type_Name_Array_Ptr is access Type_Name_Array;
        pragma Segmented_Heap (Type_Name_Array_Ptr);
        type Range_Data_Record (Form : Expression_Form :=
                                   Checking.Other_Form) is
            record
                case Form is
                    when Integer_Form =>
                        Integer_Lo : Universal.Integer;
                        Integer_Hi : Universal.Integer;
                    when Real_Form =>  
                        Real_Lo : Universal.Float;
                        Real_Hi : Universal.Float;  
                    when Other_Form =>
                        null;
                end case;
            end record;

        type Range_Data is access Range_Data_Record;
        pragma Segmented_Heap (Range_Data);

        type Range_Constraint_Record  
                (Must_Be_Static : Boolean := False) is
            record  
                case Must_Be_Static is
                    when True =>
                        The_Range_Data : Range_Data;
                    when False =>
                        null;
                end case;
            end record;

        type Range_Constraint is access Range_Constraint_Record;
        pragma Segmented_Heap (Range_Constraint);

        type Object_Set_Record is
            record
                Valid_Kinds : Object_Kind_Array;
                Allowed_Types : Type_Set;
                Required_Pragmas : Pragma_Array_Ptr;
                Prohibited_Pragmas : Pragma_Array_Ptr;
            end record;

        type Object_Set is access Object_Set_Record;
        pragma Segmented_Heap (Object_Set);

        type Miscellaneous_Name_Set_Record is
            record
                Miscellaneous_Name_Kinds : Miscellaneous_Name_Kind_Array;
                Ambiguity_Allowed : Boolean;
                Required_Pragmas : Pragma_Array_Ptr;
                Prohibited_Pragmas : Pragma_Array_Ptr;
            end record;

        type Miscellaneous_Name_Set is access Miscellaneous_Name_Set_Record;
        pragma Segmented_Heap (Miscellaneous_Name_Set);


        type Type_Set_Record is
            record
                Enforced_Type_Restrictions : Type_Restriction_Array;
                Valid_Structural_Types : Structural_Type_Array;
                Valid_Textual_Types : Type_Name_Array_Ptr;
                Required_Pragmas : Pragma_Array_Ptr;
                Prohibited_Pragmas : Pragma_Array_Ptr;
            end record;

        type Type_Set is access Type_Set_Record;
        pragma Segmented_Heap (Type_Set);

        type Expression_Record is
            record
                Expression_Type : Text.Item;
                Constraint : Range_Constraint;
            end record;

        type Expression is access Expression_Record;
        pragma Segmented_Heap (Expression);

    end Checking;

----------------------------------------------------------------------
    package Predefined_Environment_Characteristics is

        ----------
        type Universal_Real is private;

        type Integer_Type_Descriptor is private;

        function Is_Null (The_Integer_Type_Descriptor : Integer_Type_Descriptor)
                         return Boolean;

        function Build (Name : String;
                        Size : Natural;
                        Lo_Bound : Universal.Integer;
                        Hi_Bound : Universal.Integer;
                        For_Target : String) return Integer_Type_Descriptor;

        -- Size is measured in bits.

        function Get_Name (The_Integer : Integer_Type_Descriptor) return String;
        function Get_Size
                    (The_Integer : Integer_Type_Descriptor) return Natural;
        function Get_Lo_Bound (The_Integer : Integer_Type_Descriptor)
                              return Universal.Integer;
        function Get_Hi_Bound (The_Integer : Integer_Type_Descriptor)
                              return Universal.Integer;
        type Integer_Type_Array is
           array (Positive range <>) of Integer_Type_Descriptor;


        ----------
        type Float_Type_Descriptor is private;

        function Is_Null (The_Float_Type_Descriptor : Float_Type_Descriptor)
                         return Boolean;

        function Build (Name : String;
                        Digitz : Positive;
                        Size : Positive;
                        Lo_Bound : Universal.Real;
                        Hi_Bound : Universal.Real;
                        -- The following fields need only be accurately
                        -- set if the user expects the corresponding
                        -- LRM attributes for the given float type to be
                        -- used in expressions that are required to be static.
                        Safe_Emax : Integer := 0;
                        Machine_Emax : Integer := 0;
                        Machine_Emin : Integer := 0;
                        Machine_Radix : Positive := 1;
                        Machine_Mantissa : Positive := 1;
                        Machine_Rounds : Boolean := True;
                        Machine_Overflows : Boolean := True;
                        For_Target : String) return Float_Type_Descriptor;

        -- Size is measured in bits.

        function Get_Name (The_Float : Float_Type_Descriptor) return String;
        function Get_Digits (The_Float : Float_Type_Descriptor) return Positive;
        function Get_Size (The_Float : Float_Type_Descriptor) return Positive;
        function Get_Lo_Bound (The_Float : Float_Type_Descriptor)
                              return Universal.Real;
        function Get_Hi_Bound (The_Float : Float_Type_Descriptor)
                              return Universal.Real;
        function Get_Safe_Emax
                    (The_Float : Float_Type_Descriptor) return Integer;
        function Get_Machine_Emax
                    (The_Float : Float_Type_Descriptor) return Integer;
        function Get_Machine_Emin
                    (The_Float : Float_Type_Descriptor) return Integer;
        function Get_Machine_Radix
                    (The_Float : Float_Type_Descriptor) return Positive;
        function Get_Machine_Mantissa
                    (The_Float : Float_Type_Descriptor) return Positive;
        function Get_Machine_Rounds
                    (The_Float : Float_Type_Descriptor) return Boolean;
        function Get_Machine_Overflows
                    (The_Float : Float_Type_Descriptor) return Boolean;

        type Float_Type_Array is
           array (Positive range <>) of Float_Type_Descriptor;


        ----------
        type Fixed_Type_Descriptor is private;

        function Is_Null (The_Fixed_Type_Descriptor : Fixed_Type_Descriptor)
                         return Boolean;

        function Build (Name : String;
                        Size : Positive;
                        Scale : Integer;
                        Lo_Bound : Universal.Real;
                        Hi_Bound : Universal.Real;
                        For_Target : String) return Fixed_Type_Descriptor;

        --   *NOTE* Duration is the only fixed_point type that should appear
        -- in package Standard.

        -- Size is measured in bits.
        -- Scale is outdated and can be set to zero.

        function Get_Name (The_Fixed : Fixed_Type_Descriptor) return String;
        function Get_Size (The_Fixed : Fixed_Type_Descriptor) return Positive;
        function Get_Scale (The_Fixed : Fixed_Type_Descriptor) return Integer;
        function Get_Lo_Bound (The_Fixed : Fixed_Type_Descriptor)
                              return Universal.Real;
        function Get_Hi_Bound (The_Fixed : Fixed_Type_Descriptor)
                              return Universal.Real;

        type Fixed_Type_Array is
           array (Positive range <>) of Fixed_Type_Descriptor;


        Dynamic_Size : constant Integer := -1;
        subtype Bits is Integer range Dynamic_Size .. Integer'Last;

        subtype Scalar_Bits is Bits range 0 .. 256;

        ----------

        type Object is private;

        function Null_Object return Object;

        function Is_Null (The_Object : Object) return Boolean;

        function Build (Standard_Version : Integer;
                        Integer_Types : Integer_Type_Array;
                        Float_Types : Float_Type_Array;
                        Duration_Type : Fixed_Type_Descriptor;
                        For_Target : String) return Object;
        -- Types should appear in increasing size order in their corresponding
        -- arrays.

        Build_Failed : exception;

        procedure Check (Standard_Version : Integer;
                         Integer_Types : Integer_Type_Array;
                         Float_Types : Float_Type_Array;
                         Duration_Type : Fixed_Type_Descriptor;
                         Status : in out Simple_Status.Condition);

        procedure Display (The_Object : Object);

        function Get_Standard_Version (The_Object : Object) return Integer;
        function Get_Integer_Types
                    (The_Object : Object) return Integer_Type_Array;
        function Get_Float_Types (The_Object : Object) return Float_Type_Array;
        function Get_Duration (The_Object : Object)
                              return Fixed_Type_Descriptor;  
    private  
        type Real_Node is new Eniversal.Real;
        type Universal_Real is access Real_Node;
        pragma Segmented_Heap (Universal_Real);

        type Integer_Type_Descriptor_Record is
            record
                Name : Text.Item;
                Size : Natural;
                Lo_Bound : Universal.Integer;
                Hi_Bound : Universal.Integer;
            end record;

        type Integer_Type_Descriptor is access Integer_Type_Descriptor_Record;
        pragma Segmented_Heap (Integer_Type_Descriptor);

        type Float_Type_Descriptor_Record is
            record
                Name : Text.Item;
                Digitz : Positive;
                Size : Positive;
                Lo_Bound : Universal_Real;
                Hi_Bound : Universal_Real;
                Safe_Emax : Integer;
                Machine_Emax : Integer;
                Machine_Emin : Integer;
                Machine_Radix : Positive;
                Machine_Mantissa : Positive;
                Machine_Rounds : Boolean;
                Machine_Overflows : Boolean;
            end record;

        type Float_Type_Descriptor is access Float_Type_Descriptor_Record;
        pragma Segmented_Heap (Float_Type_Descriptor);

        type Fixed_Type_Descriptor_Record is
            record
                Name : Text.Item;
                Size : Positive;  
                Scale : Integer;
                Lo_Bound : Universal_Real;
                Hi_Bound : Universal_Real;
            end record;
        type Fixed_Type_Descriptor is access Fixed_Type_Descriptor_Record;
        pragma Segmented_Heap (Fixed_Type_Descriptor);

        type Integer_Type_Array_Ptr is access Integer_Type_Array;
        pragma Segmented_Heap (Integer_Type_Array_Ptr);

        type Float_Type_Array_Ptr is access Float_Type_Array;
        pragma Segmented_Heap (Float_Type_Array_Ptr);
        type Fixed_Type_Array_Ptr is access Fixed_Type_Array;
        pragma Segmented_Heap (Fixed_Type_Array_Ptr);

        type Object_Record is
            record  
                Standard_Version : Integer;
                Integer_Types : Integer_Type_Array_Ptr;
                Float_Types : Float_Type_Array_Ptr;
                Duration_Type : Fixed_Type_Descriptor;
            end record;

        type Object is access Object_Record;
        pragma Segmented_Heap (Object);

    end Predefined_Environment_Characteristics;

---------------------------------------------------------------------
    package Pragma_Characteristics is

        package Pragmas renames Pragma_Characteristics;
        --  The absence or presence of impl-defined pragmas cannot alter the
        -- legality of text outside the the pragma. (LRM 2.8)
        --  An argument to a pragma can either be a name or an expression (LRM 2.8)
        --  Names appearing as pragma args can only be a name visible at the
        -- place of the pragma or an identifier specific to the pragma.

        type Ada_Pragma is (Controlled_Pragma, Elaborate_Pragma, Inline_Pragma,
                            Interface_Pragma, List_Pragma, Memory_Size_Pragma,
                            Optimize_Pragma, Pack_Pragma, Page_Pragma,
                            Priority_Pragma, Shared_Pragma, Storage_Unit_Pragma,
                            Suppress_Pragma, System_Name_Pragma);

        type Location_Kind is (Context_Clause, Comp_Unit,
                               Statement, Declaration, Task_Spec);

        type Ada_Pragma_Array is array (Ada_Pragma) of Boolean;

        No_Ada_Pragmas : constant Ada_Pragma_Array := (others => False);
        All_Ada_Pragmas : constant Ada_Pragma_Array := (others => True);

        type Location_Array is array (Location_Kind) of Boolean;

        No_Locations : constant Location_Array := (others => False);
        All_Locations : constant Location_Array := (others => True);

        ----------
        type Argument is private;

        -- A pragma Argument.  Arguments are broken down into two kinds,
        -- NAME Arguments and EXPRESSION arguments.

        -- NAME Arguments are for those arguments that are important for
        -- their identity rather than their value.  They are what ada
        -- defines as 'Names'.
        -- The ada pragmas Pack, Elaborate, and Inline each have one
        -- Name Argument.

        -- EXPRESSION arguments are values.
        -- The ada pragmas Memory_Size, Storage_Unit, and Priority each
        -- have one Expression Argument.

        -- Some pragma arguments, such as the arguments to pragmas Optimize
        -- and List, can be pragma-dependent identifiers that appear nowhere
        -- else in the program.  "Special Identifier" arguments are considered
        -- NAME Arguments.

        -- Object identifiers and function identifiers can represent both
        -- Names and Expressions.  It is important to determine whether the
        -- VALUE or the IDENTITY of the entity is utilized by the pragma.

        -- A pragma will be 'applied' to all entities supplied as Name
        -- Arguments of that pragma.  This may be relevent if the
        -- pragma shows up somewhere as a 'Required' or 'Prohibited' pragma.

        function Is_Null (The_Argument : Argument) return Boolean;

        -- A null argument means semantics should assume nothing about the
        -- argument and allow anything to be placed in that slot.

        function Build_Name_Argument
                    (Name : String;
                     Valid_Objects : Checking.Object_Set :=
                        Checking.Null_Object_Set;
                     Valid_Miscellaneous_Names :
                        Checking.Miscellaneous_Name_Set :=
                        Checking.Null_Miscellaneous_Name_Set;
                     Valid_Types : Checking.Type_Set := Checking.Null_Type_Set;
                     Valid_Special_Identifiers : Checking.Identifier_Array :=
                        Checking.No_Identifiers;
                     For_Target : String) return Argument;

        function Build_Expression_Argument
                    (Name : String;
                     Valid_Expressions : Checking.Expression;
                     For_Target : String) return Argument;

        function Get_Name (The_Argument : Argument) return String;
        function Is_Name_Argument (The_Argument : Argument) return Boolean;

        function Get_Valid_Objects (The_Argument : Argument)
                                   return Checking.Object_Set;
        function Get_Valid_Miscellaneous_Names
                    (The_Argument : Argument)
                    return Checking.Miscellaneous_Name_Set;
        function Get_Valid_Types (The_Argument : Argument)
                                 return Checking.Type_Set;
        function Get_Valid_Special_Identifiers
                    (The_Argument : Argument) return Checking.Identifier_Array;

        function Get_Valid_Expressions
                    (The_Argument : Argument) return Checking.Expression;

        type Argument_Array is array (Positive range <>) of Argument;

        function No_Arguments return Argument_Array;


        ----------
        type Target_Pragma is private;

        -- Target_Pragmas repesent pragmas defined by the target compiler.
        --    The Valid_Locations are where in a program the pragma is
        -- allowed.  (The Pragma_Locations type is obtained from
        -- the allowed locations of Ada pragmas).
        --    The last_required_argument field should equal the number
        -- of arguments a pragma has, unless some are optional.  Only
        -- arguments at the end of the list are allowed to be optional.

        function Is_Null (The_Target_Pragma : Target_Pragma) return Boolean;

        function Build (Name : String;
                        Valid_Locations : Location_Array;
                        Arguments : Argument_Array;
                        Last_Required_Argument : Natural;
                        For_Target : String) return Target_Pragma;

        function Get_Name (The_Target_Pragma : Target_Pragma) return String;
        function Get_Valid_Locations
                    (The_Target_Pragma : Target_Pragma) return Location_Array;
        function Get_Arguments
                    (The_Target_Pragma : Target_Pragma) return Argument_Array;
        function Get_Last_Required_Argument
                    (The_Target_Pragma : Target_Pragma) return Natural;

        type Target_Pragma_Array is array (Positive range <>) of Target_Pragma;

        function No_Target_Pragmas return Target_Pragma_Array;


        ----------
        type Object is private;

        function Null_Object return Object;

        function Is_Null (The_Object : Object) return Boolean;

        function Build (Supported_Ada_Pragmas : Ada_Pragma_Array;
                        Target_Pragmas : Target_Pragma_Array :=
                           Pragmas.No_Target_Pragmas;
                        Interface_Languages : Checking.Identifier_Array :=
                           Checking.No_Identifiers;
                        For_Target : String) return Object;

        -- Interface_Languages is the set of languages allowed in usages of
        -- pragma Interface.

        Build_Failed : exception;

        procedure Check (Supported_Ada_Pragmas : Ada_Pragma_Array;
                         Target_Pragmas : Target_Pragma_Array;
                         Status : in out Simple_Status.Condition);

        procedure Display (The_Object : Object);

        function Get_Supported_Ada_Pragmas
                    (The_Object : Object) return Ada_Pragma_Array;
        function Get_Target_Pragmas
                    (The_Object : Object) return Target_Pragma_Array;
        function Get_Interface_Languages (The_Object : Object)
                                         return Checking.Identifier_Array;

    private
        type Identifier_Array_Ptr is access Checking.Identifier_Array;
        pragma Segmented_Heap (Identifier_Array_Ptr);

        type Argument_Record (Is_Name : Boolean := True) is
            record
                Name : Text.Item;
                case Is_Name is
                    when True =>
                        Valid_Objects : Checking.Object_Set;
                        Valid_Miscellaneous_Names :
                           Checking.Miscellaneous_Name_Set;
                        Valid_Types : Checking.Type_Set;
                        Valid_Special_Identifiers : Identifier_Array_Ptr;
                    when False =>
                        Valid_Expressions : Checking.Expression;
                end case;
            end record;
        type Argument is access Argument_Record;
        pragma Segmented_Heap (Argument);

        type Argument_Array_Ptr is access Argument_Array;
        pragma Segmented_Heap (Argument_Array_Ptr);

        type Target_Pragma_Record is
            record
                Name : Text.Item;
                Valid_Locations : Location_Array;
                Arguments : Argument_Array_Ptr;  
                Last_Required_Argument : Natural;
            end record;
        type Target_Pragma is access Target_Pragma_Record;
        pragma Segmented_Heap (Target_Pragma);

        type Target_Pragma_Array_Ptr is access Target_Pragma_Array;
        pragma Segmented_Heap (Target_Pragma_Array_Ptr);
        type Object_Record is
            record
                Supported_Ada_Pragmas : Ada_Pragma_Array;
                Target_Pragmas : Target_Pragma_Array_Ptr;
                Interface_Languages : Identifier_Array_Ptr;
            end record;

        type Object is access Object_Record;
        pragma Segmented_Heap (Object);
    end Pragma_Characteristics;

----------------------------------------------------------------------
-- Attributes

    package Attribute_Characteristics is

        package Attributes renames Attribute_Characteristics;

        -- Attributes can be:
        --  a basic operation returning a value
        --  a function
        --  a type
        --  a range
        --  (LRM 4.1.4)

        type Result_Kind is (Value_Result, Type_Result, Range_Result);

        ----------
        type Prefix is private;

        -- A Prefix represents the prefix of a target defined attribute.
        --  eg. 'Foo' in
        --          X := Foo'Bar (4);
        -- The customizer must specify the kinds of ada names that can appear
        -- as a prefix for each attribute.

        function Is_Null (The_Prefix : Prefix) return Boolean;

        -- A null prefix means that semantics should place no restrictions
        -- on a prefix for the given attribute.

        function Build (Valid_Objects : Checking.Object_Set :=
                           Checking.Null_Object_Set;
                        Valid_Miscellaneous_Names :
                           Checking.Miscellaneous_Name_Set :=
                           Checking.Null_Miscellaneous_Name_Set;
                        Valid_Types : Checking.Type_Set :=
                           Checking.Null_Type_Set;
                        For_Target : String) return Prefix;

        function Get_Valid_Objects (The_Prefix : Prefix)
                                   return Checking.Object_Set;
        function Get_Valid_Miscellaneous_Names
                    (The_Prefix : Prefix) return Checking.
                                                 Miscellaneous_Name_Set;
        function Get_Valid_Types (The_Prefix : Prefix) return Checking.Type_Set;

        ----------
        type Result is private;

        -- A Result represents the result of a target-defined attribute.
        -- Some attributes return ranges, some return types, and most return
        -- single values.  R1000 semantics does not fully support target
        -- attributes with range or type results at this time.

        function Is_Null (The_Result : Result) return Boolean;

        function Prefix_Value (For_Target : String) return Result;

        function Prefix_Range (For_Target : String) return Result;

        function Build_With_Value_Result
                    (Type_Name : String; For_Target : String) return Result;
        function Build_With_Range_Result
                    (Type_Name : String; For_Target : String) return Result;
        function Build_With_Type_Result (For_Target : String) return Result;

        function Get_Result_Kind (The_Result : Result) return Result_Kind;
        function Is_Prefix_Type (The_Result : Result) return Boolean;
        function Get_Name (The_Result : Result) return String;

        ----------
        type Designator is private;

        -- Ada defines the Designator of an attribute expression such as
        -- "Foo'Bar (Baz)" to be the attribute name and the optional parameter
        -- (In this case, "Bar (Baz)".   However, the Rcf makes the
        -- attribute name a separate component of an abstract attribute, so a
        -- Designator represents only the parameter.

        function Null_Designator return Designator;
        function Is_Null (The_Designator : Designator) return Boolean;

        -- Null designator implies no parameter.

        function Prefix_Designator (For_Target : String) return Designator;

        -- A "Prefix" designator means the parameter type is the type of
        -- the prefix.  If the prefix is not a type, it is illegal to declare
        -- a prefix_designator.

        function Build (Function_Parameter : Checking.Expression;
                        For_Target : String) return Designator;

        function Is_Prefix_Type (The_Designator : Designator) return Boolean;
        function Get_Function_Parameter
                    (The_Designator : Designator) return Checking.Expression;

        ----------
        type Attribute is private;
        function Is_Null (The_Attribute : Attribute) return Boolean;

        function Build (The_Name : String;
                        The_Prefix : Prefix;
                        The_Result : Result;
                        The_Designator : Designator :=
                           Attributes.Null_Designator;
                        For_Target : String) return Attribute;

        function Get_Name (The_Attribute : Attribute) return String;
        function Get_Prefix (The_Attribute : Attribute) return Prefix;
        function Get_Result (The_Attribute : Attribute) return Result;
        function Get_Designator (The_Attribute : Attribute) return Designator;

        type Attribute_Array is array (Positive range <>) of Attribute;

        function No_Attributes return Attribute_Array;


        ----------
        type Object is private;

        function Null_Object return Object;

        function Is_Null (The_Object : Object) return Boolean;

        function Build (Attribute_List : Attribute_Array :=
                           Attributes.No_Attributes;
                        For_Target : String) return Object;

        Build_Failed : exception;

        procedure Check (Attributes : Attribute_Array;
                         Status : in out Simple_Status.Condition);

        procedure Display (The_Object : Object);

        function Get_Attributes (The_Object : Object) return Attribute_Array;

    private

        type Prefix_Record is
            record
                Valid_Objects : Checking.Object_Set;
                Valid_Miscellaneous_Names : Checking.Miscellaneous_Name_Set;
                Valid_Types : Checking.Type_Set;
            end record;
        type Prefix is access Prefix_Record;
        pragma Segmented_Heap (Prefix);

        type Result_Record (The_Kind : Result_Kind := Value_Result;
                            Is_Prefix_Type : Boolean := False) is
            record
                case The_Kind is
                    when Type_Result =>
                        null;
                    when Value_Result | Range_Result =>
                        case Is_Prefix_Type is
                            when True =>
                                null;
                            when False =>
                                Name : Text.Item;
                        end case;

                end case;
            end record;

        type Result is access Result_Record;
        pragma Segmented_Heap (Result);

        type Designator_Record (Is_Prefix_Type : Boolean := False) is
            record
                case Is_Prefix_Type is
                    when True =>
                        null;
                    when False =>
                        Function_Parameter : Checking.Expression;
                end case;
            end record;
        type Designator is access Designator_Record;
        pragma Segmented_Heap (Designator);

        type Attribute_Record is
            record
                The_Name : Text.Item;
                The_Prefix : Prefix;
                The_Result : Result;
                The_Designator : Designator;
            end record;
        type Attribute is access Attribute_Record;
        pragma Segmented_Heap (Attribute);


        type Object is access Attribute_Array;
        pragma Segmented_Heap (Object);


    end Attribute_Characteristics;

----------------------------------------------------------------------

    package Rep_Spec_Characteristics is

        package Rep_Specs renames Rep_Spec_Characteristics;

        Last_Address_Clause_Object :
           Checking.Miscellaneous_Name_Kind := Checking.Entry_Kind;

        subtype Address_Clause_Miscellaneous_Name_Kind is
           Checking.Miscellaneous_Name_Kind
              range Checking.Miscellaneous_Name_Kind'First ..
                       Last_Address_Clause_Object;

        type Address_Clause_Miscellaneous_Name_Kind_Array is
           array (Address_Clause_Miscellaneous_Name_Kind) of Boolean;

        subtype Address_Clause_Miscellaneous_Name_Set is
           Address_Clause_Miscellaneous_Name_Kind_Array;

        ----------
        type Address_Clause_Data is private;

        function Null_Address_Clause_Data return Address_Clause_Data;
        function Is_Null (The_Address_Clause_Data : Address_Clause_Data)
                         return Boolean;

        function Build (Valid_Objects : Checking.Object_Set :=
                           Checking.Null_Object_Set;
                        Valid_Miscellaneous_Names :
                           Checking.Miscellaneous_Name_Set :=
                           Checking.Null_Miscellaneous_Name_Set;
                        For_Target : String) return Address_Clause_Data;

        function Get_Valid_Objects
                    (The_Address_Clause_Data : Address_Clause_Data)
                    return Checking.Object_Set;
        function Get_Valid_Miscellaneous_Names
                    (The_Address_Clause_Data : Address_Clause_Data)
                    return Checking.Miscellaneous_Name_Set;

        ----------
        type Storage_Size_Data is private;

        -- Storage_size_data describes the restrictions placed on the usage
        -- of storage_size representation clauses.

        function Null_Storage_Size_Data return Storage_Size_Data;

        -- Null Storage_Size_data means that no target-dependent checks will
        -- be made on storage_size specifications.

        function Is_Null
                    (The_Storage_Size_Data : Storage_Size_Data) return Boolean;

        function Build (Allowed_For_Task : Boolean := False;
                        Allowed_For_Access_Types : Boolean := False;
                        Allowed_With_Size_Specs : Boolean := False;
                        Task_Upper_Bound : Universal.Integer := Universal.Zero;
                        Access_Upper_Bound :
                           Universal.Integer := Universal.Zero;
                        For_Target : String) return Storage_Size_Data;

        function Is_Allowed_For_Tasks
                    (The_Storage_Size_Data : Storage_Size_Data) return Boolean;
        function Is_Allowed_For_Access_Types
                    (The_Storage_Size_Data : Storage_Size_Data) return Boolean;
        function Is_Allowed_With_Size_Specs
                    (The_Storage_Size_Data : Storage_Size_Data) return Boolean;
        function Get_Task_Upper_Bound
                    (The_Storage_Size_Data : Storage_Size_Data)
                    return Universal.Integer;
        function Get_Access_Upper_Bound
                    (The_Storage_Size_Data : Storage_Size_Data)
                    return Universal.Integer;

        ----------
        type Object is private;

        function Null_Object return Object;

        function Is_Null (The_Object : Object) return Boolean;

        function Build (Address_Clause_Info : Address_Clause_Data :=
                           Rep_Specs.Null_Address_Clause_Data;
                        Storage_Size_Info : Storage_Size_Data :=
                           Rep_Specs.Null_Storage_Size_Data;
                        For_Target : String) return Object;

        Build_Failed : exception;

        procedure Check (Address_Clause_Info : Address_Clause_Data;
                         Storage_Size_Info : Storage_Size_Data;
                         Status : in out Simple_Status.Condition);

        procedure Display (The_Object : Object);

        function Get_Address_Clause_Info
                    (The_Object : Object) return Address_Clause_Data;
        function Get_Storage_Size_Info
                    (The_Object : Object) return Storage_Size_Data;

    private

        type Address_Clause_Data_Record is
            record
                Valid_Objects : Checking.Object_Set;
                Valid_Miscellaneous_Names : Checking.Miscellaneous_Name_Set;
            end record;
        type Address_Clause_Data is access Address_Clause_Data_Record;
        pragma Segmented_Heap (Address_Clause_Data);

        type Storage_Size_Data_Record is
            record
                Allowed_For_Tasks : Boolean := False;
                Allowed_For_Access_Types : Boolean := False;
                Allowed_With_Size_Spec : Boolean := False;
                Task_Upper_Bound : Universal.Integer := Universal.Zero;
                Access_Upper_Bound : Universal.Integer := Universal.Zero;
            end record;
        type Storage_Size_Data is access Storage_Size_Data_Record;
        pragma Segmented_Heap (Storage_Size_Data);

        type Object_Record is
            record
                Address_Clause_Info : Address_Clause_Data;
                Storage_Size_Info : Storage_Size_Data;
            end record;
        type Object is access Object_Record;
        pragma Segmented_Heap (Object);

    end Rep_Spec_Characteristics;
----------------------------------------------------------------------

    pragma Module_Name (4, 4143);
    pragma Bias_Key (32);

end Semantic_Characteristics;