|
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 - download
Length: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, function Get_Attribute_Info, seg_0508f7, 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_Attributes;
separate (Rs6000_Aix_Vads)
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 "IBM RISC System/6000 AIX - Version 6.2.1"
-- Programmer's Guide. These include:
--
-- X'Address,
-- X'Ref and System.Address'Ref(N)
-- X'Task_Id
-- X'Long_Address
--
-- 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 RCI 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.
-----------------------------------------------------------------------------------
-- P'Long_Address
--
-- For a prefix P that denotes an object, a program unit, a label or an entry
--
-- Yields the address of the first of the storage units allocated to P
-- The only difference betwen 'Address and 'Long_Address is that the value of
-- the second one is of the type Long_address.
Long_Address_Type_Set : Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => Checking.No_Structural_Types,
Valid_Textual_Types => Checking.No_Type_Names,
Required_Pragmas => Checking.No_Pragmas,
Prohibited_Pragmas => Checking.No_Pragmas,
For_Target => T_Name);
Long_Address_Objects : constant Checking.Object_Set :=
Checking.Build (Valid_Kinds => Checking.All_Object_Kinds,
Allowed_Types => Long_Address_Type_Set,
Required_Pragmas => Checking.No_Pragmas,
Prohibited_Pragmas => Checking.No_Pragmas,
For_Target => T_Name);
Long_Address_Misc_Names : constant Checking.Miscellaneous_Name_Set :=
Checking.Build (Valid_Kinds => (Checking.Task_Kind => False,
Checking.Named_Statement_Kind => False,
others => True),
Ambiguity_Allowed => False,
Required_Pragmas => Checking.No_Pragmas,
Prohibited_Pragmas => Checking.No_Pragmas,
For_Target => T_Name);
Long_Address_Prefix : constant Attr.Prefix :=
Attr.Build (Valid_Objects => Long_Address_Objects,
Valid_Miscellaneous_Names => Long_Address_Misc_Names,
Valid_Types => Checking.Null_Type_Set,
For_Target => T_Name);
Long_Address_Result : constant Attr.Result :=
Attr.Build_With_Value_Result
(Type_Name => "system.long_address", For_Target => T_Name);
Long_Address_Designator : constant Attr.Designator :=
Attributes.Null_Designator;
Long_Address_Attr : constant Attr.Attribute :=
Attr.Build (The_Name => "Long_Address",
The_Prefix => Long_Address_Prefix,
The_Result => Long_Address_Result,
The_Designator => Long_Address_Designator,
For_Target => T_Name);
-----------------------------------------------------------------------------------
-- '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,
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,
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,
4 => Long_Address_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;
nblk1=c
nid=0
hdr6=18
[0x00] rec0=1b rec1=00 rec2=01 rec3=07c
[0x01] rec0=16 rec1=00 rec2=02 rec3=050
[0x02] rec0=12 rec1=00 rec2=03 rec3=03c
[0x03] rec0=17 rec1=00 rec2=04 rec3=00c
[0x04] rec0=19 rec1=00 rec2=05 rec3=02a
[0x05] rec0=18 rec1=00 rec2=06 rec3=012
[0x06] rec0=15 rec1=00 rec2=07 rec3=02a
[0x07] rec0=12 rec1=00 rec2=08 rec3=01c
[0x08] rec0=17 rec1=00 rec2=09 rec3=052
[0x09] rec0=16 rec1=00 rec2=0a rec3=050
[0x0a] rec0=19 rec1=00 rec2=0b rec3=05c
[0x0b] rec0=19 rec1=00 rec2=0c rec3=000
tail 0x21757f440878e74641c9d 0x42a00088462060003