|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 9429 (0x24d5)
Types: TextFile
Names: »B«
└─⟦516dceb10⟧ Bits:30000751 8mm tape, Rational 1000, RCI_VADS
└─ ⟦9a14c9417⟧ »DATA«
└─⟦this⟧
-- WITH Get_Attributes;
separate (M68k_Sunos_Vdx)
function Get_Attribute_Info return Attributes.Object is
package Attr renames Attributes;
-- GENERAL NOTES PERTAINING TO ATTRIBUTES DEFINED HERE
--
-- There are three "implementation dependant" attributes documented in
-- the Appendix F found in the "Sun Ada 1.0 for Sun4 SunOS 4.x"
-- Programmer's Guide. These include:
--
-- X'Address,
-- X'Ref and System.Address'Ref(N), and
-- X'Task_Id
--
-- The implementation for the X'Address attribute is already provided
-- by the R1000 semanticist and is therefore not defined here.
--
-- 'Ref is "overloaded" in that it has two permitted forms. The form
-- X'Ref is used only in machine code insertions. Both forms could not
-- be implemented in the RCI. Because machine code insertions should be
-- used somewhat infrequently, this customization implements only the
-- System.Address'Ref(N) form.
--
-- In the case of both System.Address'Ref(N) and X'Task_Id a known bug
-- in the Rev1_0_0 release of the RCF prevents usages of these
-- attributes in a view using this customization from semantizing
-- properly. The bug has reportedly been fixed in the upcoming
-- maintanence release. Once this release becomes available, the use
-- of these attributes will have to be tested. It is believed that
-- they are properly defined here.
--
-- 'Ref has two permitted forms
--
-- X'Ref - Used only in machine_code procedures
-- X must be either a constant, variable, procedure, function, or
-- label.
-- Returns a value of type Machine_Code.Operand.
-- May be used only to designate an operand within a code-statement.
--
-- System.Address'Ref(N) - Used anywhere to convert the
-- Universal_Integer value N to an Address.
-- Returns a type of System.Address.
-- N must be a static value of type Universal_Integer.
--
-- Of the two permitted forms, only System.Address'Ref(N) is
-- implemented at this time.
Ref_Textual_Types : constant Checking.Type_Name_Array :=
(1 => Text.Build (S => "System.Address", For_Target => T_Name));
Ref_Type_Set : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.All_Type_Restrictions,
Valid_Structural_Types => Checking.No_Structural_Types,
Valid_Textual_Types => Ref_Textual_Types,
For_Target => T_Name);
Ref_Prefix : constant Attr.Prefix :=
Attr.Build (Valid_Objects => Checking.Null_Object_Set,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Ref_Type_Set,
For_Target => T_Name);
Ref_Result : constant Attr.Result :=
Attr.Build_With_Value_Result
(Type_Name => "System.Address", For_Target => T_Name);
Ref_Designator : constant Attr.Designator :=
Attr.Build (Function_Parameter =>
Checking.Build
(Expression_Type => "Universal_Integer",
Constraint => Checking.Null_Constraint (T_Name),
For_Target => T_Name),
For_Target => T_Name);
Ref_Attr : constant Attr.Attribute :=
Attr.Build (The_Name => "Ref",
The_Prefix => Ref_Prefix,
The_Result => Ref_Result,
The_Designator => Ref_Designator,
For_Target => T_Name);
----------------------------------------------------------------------
Xref_Type_Set : 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);
Xref_Objects : constant Checking.Object_Set :=
Checking.Build (Valid_Kinds => (Checking.Constant_Kind => True,
Checking.Variable => True,
Checking.In_Parameter => True,
Checking.Out_Parameter => True,
Checking.In_Out_Parameter => True,
others => False),
Allowed_Types => Xref_Type_Set,
Required_Pragmas => Checking.No_Pragmas,
Prohibited_Pragmas => Checking.No_Pragmas,
For_Target => T_Name);
Xref_Misc_Names : constant Checking.Miscellaneous_Name_Set :=
Checking.Build (Valid_Kinds =>
(Checking.Function_Kind => True,
Checking.Procedure_Kind => True,
Checking.Label_Kind => True,
Checking.Enumeration_Literal_Kind => True,
Checking.Generic_Function_Kind => True,
Checking.Generic_Procedure_Kind => True,
Checking.Generic_Formal_Function => True,
Checking.Generic_Formal_Procedure => True,
others => False),
Ambiguity_Allowed => False,
Required_Pragmas => Checking.No_Pragmas,
Prohibited_Pragmas => Checking.No_Pragmas,
For_Target => T_Name);
Xref_Prefix : constant Attr.Prefix :=
Attr.Build (Valid_Objects => Xref_Objects,
Valid_Miscellaneous_Names => Xref_Misc_Names,
Valid_Types => Checking.Null_Type_Set,
For_Target => T_Name);
Xref_Result : constant Attr.Result :=
Attr.Build_With_Value_Result
(Type_Name => "Machine_Code.Operand", For_Target => T_Name);
Xref_Designator : constant Attr.Designator := Attributes.Null_Designator;
Xref_Attr : constant Attr.Attribute :=
Attr.Build (The_Name => "Ref",
The_Prefix => Xref_Prefix,
The_Result => Xref_Result,
The_Designator => Xref_Designator,
For_Target => T_Name);
---------------------------------------------------------------------------
-- X'Task_Id
-- X is supposed to be limited to a "task object or a value". However,
-- the SunAda documentation is unclear as to what they mean by "a
-- value" in this context. At this time, the implementation limits use
-- of the 'Task_Id to objects which are task types or are derived from
-- task types.
Task_Id_Types_Set : 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_Id_Object_Set : constant Checking.Object_Set :=
Checking.Build (Valid_Kinds => Checking.All_Object_Kinds,
Allowed_Types => Task_Id_Types_Set,
For_Target => T_Name);
Task_Id_Misc_Name_Set : constant Checking.Miscellaneous_Name_Set :=
Checking.Build (Valid_Kinds =>
(Checking.Task_Kind => True, others => False),
For_Target => T_Name);
Task_Id_Prefix : constant Attr.Prefix :=
Attr.Build (Valid_Objects => Task_Id_Object_Set,
Valid_Miscellaneous_Names => Task_Id_Misc_Name_Set,
Valid_Types => Checking.Null_Type_Set,
For_Target => T_Name);
Task_Id_Result : constant Attr.Result :=
Attr.Build_With_Value_Result
(Type_Name => "System.Task_Id", For_Target => T_Name);
Task_Id_Designator : constant Attr.Designator := Attr.Null_Designator;
Task_Id_Attr : constant Attr.Attribute :=
Attr.Build (The_Name => "Task_Id",
The_Prefix => Task_Id_Prefix,
The_Result => Task_Id_Result,
The_Designator => Task_Id_Designator,
For_Target => T_Name);
-----------------------------------------------------------------------
Attr_List : constant Attr.Attribute_Array :=
(1 => Ref_Attr, 2 => Xref_Attr, 3 => Task_Id_Attr);
begin
-- FOR I IN Attr_List'Range LOOP
-- Io.Put_Line (Attr.Get_Name (Attr_List (I)));
-- Io.Put_Line (" Result: " & Attr.Get_Name
-- (Attr.Get_Result (Attr_List (I))));
-- END LOOP;
--
return Attr.Build (Attribute_List => Attr_List, For_Target => T_Name);
-- RETURN Get_Attributes (T_Name);
end Get_Attribute_Info;