|
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