|
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: 20409 (0x4fb9)
Types: TextFile
Names: »B«
└─⟦25882cbde⟧ Bits:30000536 8mm tape, Rational 1000, RCI_RS6000_AIX_IBM 2_0_2
└─ ⟦b8efda8ac⟧ »DATA«
└─⟦7061b4ee8⟧
└─⟦this⟧
with Log;
with Operational_Characteristics;
with Telnet_Characteristics;
with Product_Authorization;
with Profile;
with Rci_Customization_Interface;
with Simple_Status;
with String_Utilities;
with Universal;
package body Rci_Semantics is
package Op renames Operational_Characteristics;
package Tc renames Telnet_Characteristics;
package Rci renames Rci_Customization_Interface;
package Ss renames Simple_Status;
package Checking renames Sc.Checking;
package Text renames Sc.Text;
package Su renames String_Utilities;
Rs6000_Target : constant String := "Rs6000_Aix_Ibm";
Supported_Targets : array (1 .. 7) of String (1 .. 16) :=
(1 => "Rs6000_Aix_Ibm ",
2 => "Vax_Vms_Dec ",
3 => "I386_Lynx_Als ",
4 => "I486_Iux_Als ",
5 => "I960_Vms_Tar ",
6 => "IC30_Vms_Tar ",
7 => "Sparc_SunOs_Sun ");
function Is_Authorized (Target_Key_Name : String) return Boolean is
begin
for I in Supported_Targets'First .. Supported_Targets'Last loop
if Su.Equal (Str1 => Su.Strip (Target_Key_Name),
Str2 => Su.Strip (Supported_Targets (I)),
Ignore_Case => True) then
return Product_Authorization.Is_Registered (Target_Key_Name);
end if;
end loop;
return True;
end Is_Authorized;
function Get_Attribute_Info
(Target_Key_Name : String) return Attributes.Object is
begin
if not Is_Authorized (Rs6000_Target) then
Log.Put_Line
(Message =>
"The " & Rs6000_Target &
" target has not been authorized on this machine.",
Kind => Profile.Error_Msg);
raise Program_Error;
end if;
return Attributes.Build (For_Target => Target_Key_Name);
end Get_Attribute_Info;
function Get_Predefined_Info
(Target_Key_Name : String) return Predefined.Object is
Short_Int : constant Predefined.Integer_Type_Descriptor :=
Predefined.Build
(Name => "SHORT_INTEGER",
Size => 16,
Lo_Bound => Universal.Value (Integer'(-2 ** 15)),
Hi_Bound => Universal.Value (Integer'(2 ** 15 - 1)),
For_Target => Target_Key_Name);
Int : constant Predefined.Integer_Type_Descriptor :=
Predefined.Build
(Name => "INTEGER",
Size => 32,
Lo_Bound => Universal.Value (Long_Integer'(-2 ** 31)),
Hi_Bound => Universal.Value (Long_Integer'(2 ** 31 - 1)),
For_Target => Target_Key_Name);
Integers : constant Predefined.Integer_Type_Array := (Short_Int, Int);
--------------------------------------------------
Single_Last : constant Universal.Real := Universal.Value (3.40282E+38);
Double_Last : constant Universal.Real :=
Universal.Value (1.79769313486231E+308);
Flo : constant Predefined.Float_Type_Descriptor :=
Predefined.Build
(Name => "FLOAT",
Digitz => 6,
Size => 32,
Lo_Bound => Universal."-" (Single_Last),
Hi_Bound => Single_Last,
Safe_Emax => 125,
Machine_Emin => -125,
Machine_Emax => 128,
Machine_Radix => 2,
Machine_Mantissa => 21,
Machine_Rounds => True, -- We don't know this
Machine_Overflows => True, -- We don't know this
For_Target => Target_Key_Name);
Long_Flo : constant Predefined.Float_Type_Descriptor :=
Predefined.Build
(Name => "LONG_FLOAT",
Digitz => 15,
Size => 64,
Lo_Bound => Universal."-" (Double_Last),
Hi_Bound => Double_Last,
Safe_Emax => 1020,
Machine_Emin => -1021,
Machine_Emax => 1024,
Machine_Radix => 2,
Machine_Mantissa => 53,
Machine_Rounds => True, -- We don't know this
Machine_Overflows => True, -- We don't know this
For_Target => Target_Key_Name);
Floats : constant Predefined.Float_Type_Array := (Flo, Long_Flo);
--------------------------------------------------
Dur : constant Predefined.Fixed_Type_Descriptor :=
Predefined.Build (Name => "DURATION",
Size => 32,
Scale => -14,
Lo_Bound => Universal.Value (-86400.0),
Hi_Bound => Universal.Value (86400.0),
For_Target => Target_Key_Name);
--------------------------------------------------
Predefined_Characteristics : constant Predefined.Object :=
Predefined.Build (Standard_Version => 1,
Integer_Types => Integers,
Float_Types => Floats,
Duration_Type => Dur,
For_Target => Target_Key_Name);
begin
if not Is_Authorized (Rs6000_Target) then
Log.Put_Line
(Message =>
"The " & Rs6000_Target &
" target has not been authorized on this machine.",
Kind => Profile.Error_Msg);
raise Program_Error;
end if;
return Predefined_Characteristics;
end Get_Predefined_Info;
function Get_Pragma_Info (Target_Key_Name : String) return Pragmas.Object is
Comment_Arguments : constant Pragmas.Argument_Array :=
(1 => Pragmas.Build_Expression_Argument
(Name => "String_Literal",
Valid_Expressions =>
Checking.Build
(Expression_Type => "String",
Constraint => Checking.Null_Constraint
(For_Target => Target_Key_Name),
For_Target => Target_Key_Name),
For_Target => Target_Key_Name));
Comment_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Comment",
Valid_Locations => (others => True),
Arguments => Comment_Arguments,
Last_Required_Argument => 1,
For_Target => Target_Key_Name);
----------------------------------------------------------------------
Images_Types : Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types =>
(Checking.Enumeration_Type => True,
others => False),
For_Target => Target_Key_Name);
Images_Arg1 : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument (Name => "Enumeration_Type",
Valid_Types => Images_Types,
For_Target => Target_Key_Name);
Images_Arg2 : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "When_Generated",
Valid_Special_Identifiers =>
(Text.Build ("Immediate", Target_Key_Name),
Text.Build ("Deferred", Target_Key_Name)),
For_Target => Target_Key_Name);
Images_Arguments : constant Pragmas.Argument_Array :=
(Images_Arg1, Images_Arg2);
Images_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Images",
Valid_Locations => (Pragmas.Declaration => True,
Pragmas.Task_Spec => True,
others => False),
Arguments => Images_Arguments,
Last_Required_Argument => 2,
For_Target => Target_Key_Name);
----------------------------------------------------------------------
Linkname_Arguments : constant Pragmas.Argument_Array :=
(Pragmas.Build_Name_Argument
(Name => "Interfaced_Subprogram_Name",
Valid_Miscellaneous_Names =>
Checking.Build (Valid_Kinds =>
(Checking.Function_Kind => True,
Checking.Procedure_Kind => True,
others => False),
Ambiguity_Allowed => False,
For_Target => Target_Key_Name),
For_Target => Target_Key_Name),
Pragmas.Build_Expression_Argument
(Name => "Link_Name",
Valid_Expressions =>
Checking.Build (Expression_Type => "String",
Constraint => Checking.Null_Constraint
(Target_Key_Name),
For_Target => Target_Key_Name),
For_Target => Target_Key_Name));
Linkname_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Linkname",
Valid_Locations => (Pragmas.Declaration => True,
Pragmas.Statement => True,
Pragmas.Task_Spec => True,
others => False),
Arguments => Linkname_Arguments,
Last_Required_Argument => 2,
For_Target => Target_Key_Name);
----------------------------------------------------------------------
--PRAGMA INTERFACE_INFORMATION (Ada_Name,"LinkName" [, "Stack_Size=>Bytes"]);
Interface_Information_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 => Target_Key_Name);
Interface_Information_Objects : Checking.Object_Set :=
Checking.Build
(Valid_Kinds =>
(Checking.Variable => True,
others => False
),
Allowed_Types => Interface_Information_Allowed_Types,
For_Target => Target_Key_Name);
Interface_Information_Required_Pragmas :
constant Checking.Pragma_Array :=
(1 => Text.Build (S => "Interface", For_Target => Target_Key_Name));
Interface_Information_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_Information_Required_Pragmas,
For_Target => Target_Key_Name);
Null_Constraint : constant Checking.Range_Constraint :=
Checking.Null_Constraint (For_Target => Target_Key_Name);
String_Expression : constant Checking.Expression :=
Checking.Build (Expression_Type => "String",
Constraint => Null_Constraint,
For_Target => Target_Key_Name);
Link_Name_Arg : constant Pragmas.Argument :=
Pragmas.Build_Expression_Argument
(Name => "Link_Name",
Valid_Expressions => String_Expression,
For_Target => Target_Key_Name);
Stack_Arg : constant Pragmas.Argument :=
Pragmas.Build_Expression_Argument
(Name => "Stack_Size",
Valid_Expressions => String_Expression,
For_Target => Target_Key_Name);
Interface_Information_Arg_1 : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "Ada_Name",
Valid_Objects => Interface_Information_Objects,
Valid_Miscellaneous_Names => Interface_Information_Misc_Names,
For_Target => Target_Key_Name);
Interface_Information_Arguments : constant Pragmas.Argument_Array :=
(Interface_Information_Arg_1, Link_Name_Arg, Stack_Arg);
Interface_Information_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build
(Name => "Interface_Information",
Valid_Locations =>
(Pragmas.Declaration => True,
others => False),
Arguments => Interface_Information_Arguments,
Last_Required_Argument => 2,
For_Target => Target_Key_Name);
----------------------------------------------------------------------
Null_Argument : Pragmas.Argument;
Unknown_Arguments : constant Pragmas.Argument_Array :=
(1 => Null_Argument);
Suppress_All_Pragma : Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Suppress_All",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => Unknown_Arguments,
Last_Required_Argument => 0,
For_Target => Target_Key_Name);
Suppress_Check_Arg : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "Conditions",
Valid_Special_Identifiers =>
(Text.Build ("ACCESS_CHECK", Target_Key_Name),
Text.Build ("DISCRIMINANT_CHECK", Target_Key_Name),
Text.Build ("INDEX_CHECK", Target_Key_Name),
Text.Build ("LENGTH_CHECK", Target_Key_Name),
Text.Build ("RANGE_CHECK", Target_Key_Name),
Text.Build ("DIVISION_CHECK", Target_Key_Name),
Text.Build ("OVERFLOW_CHECK", Target_Key_Name),
Text.Build ("ELABORATION_CHECK", Target_Key_Name),
Text.Build ("STORAGE_CHECK", Target_Key_Name)),
For_Target => Target_Key_Name);
No_Suppress_Check_Args : constant Pragmas.Argument_Array :=
(1 => Suppress_Check_Arg);
No_Suppress_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "NO_SUPPRESS",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => No_Suppress_Check_Args,
Last_Required_Argument => 1,
For_Target => Target_Key_Name);
----------------------------------------------------------------------
Layout_Type_Record_Only : constant Checking.Structural_Type_Array :=
Checking.Structural_Type_Array'
(Checking.Record_Type => True, others => False);
Layout_Type_Set : constant Checking.Type_Set :=
Checking.Build (Enforced_Type_Restrictions =>
Checking.No_Type_Restrictions,
Valid_Structural_Types => Layout_Type_Record_Only,
For_Target => Target_Key_Name);
Preserve_Layout_Arg : constant Pragmas.Argument :=
Pragmas.Build_Name_Argument
(Name => "RECORD_TYPE",
Valid_Objects => Checking.Null_Object_Set,
Valid_Miscellaneous_Names =>
Checking.Null_Miscellaneous_Name_Set,
Valid_Types => Layout_Type_Set,
Valid_Special_Identifiers => Checking.No_Identifiers,
For_Target => Target_Key_Name);
Preserve_Layout_Args : constant Pragmas.Argument_Array :=
(1 => Preserve_Layout_Arg);
Preserve_Layout_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "PRESERVE_LAYOUT",
Valid_Locations =>
(Pragmas.Declaration => True, others => False),
Arguments => Preserve_Layout_Args,
Last_Required_Argument => 1,
For_Target => Target_Key_Name);
----------------------------------------------------------------------
Os_Task_Arguments : constant Pragmas.Argument_Array :=
(1 => Pragmas.Build_Expression_Argument
(Name => "Priority",
Valid_Expressions =>
Checking.Build (Expression_Type => "System.Priority",
Constraint => Checking.Null_Constraint
(Target_Key_Name),
For_Target => Target_Key_Name),
For_Target => Target_Key_Name));
Os_Task_Pragma : constant Pragmas.Target_Pragma :=
Pragmas.Build (Name => "Os_Task",
Valid_Locations => (Pragmas.Declaration => True,
Pragmas.Task_Spec => True,
others => False),
Arguments => Os_Task_Arguments,
Last_Required_Argument => 1,
For_Target => Target_Key_Name);
----------------------------------------------------------------------
Pragma_List : constant Pragmas.Target_Pragma_Array :=
(Comment_Pragma, Images_Pragma, Linkname_Pragma, Os_Task_Pragma,
Interface_Information_Pragma, No_Suppress_Pragma,
Preserve_Layout_Pragma, Suppress_All_Pragma);
Ada_Pragmas : constant Pragmas.Ada_Pragma_Array :=
(Pragmas.Controlled_Pragma => False,
Pragmas.Elaborate_Pragma => True,
Pragmas.Inline_Pragma => True,
Pragmas.Interface_Pragma => True,
Pragmas.List_Pragma => True,
Pragmas.Memory_Size_Pragma => False,
Pragmas.Optimize_Pragma => False,
Pragmas.Pack_Pragma => True,
Pragmas.Page_Pragma => True,
Pragmas.Priority_Pragma => True,
Pragmas.Shared_Pragma => False,
Pragmas.Storage_Unit_Pragma => False,
Pragmas.Suppress_Pragma => True,
Pragmas.System_Name_Pragma => False); --[ ??? ]
Pragma_Object : Pragmas.Object :=
Pragmas.Build (Supported_Ada_Pragmas => Ada_Pragmas,
Target_Pragmas => Pragma_List,
Interface_Languages =>
(Text.Build ("Assembly", Target_Key_Name),
Text.Build ("C", Target_Key_Name),
Text.Build ("Fortran", Target_Key_Name)),
For_Target => Target_Key_Name);
begin
if not Is_Authorized (Rs6000_Target) then
Log.Put_Line
(Message =>
"The " & Rs6000_Target &
" target has not been authorized on this machine.",
Kind => Profile.Error_Msg);
raise Program_Error;
end if;
return Pragma_Object;
end Get_Pragma_Info;
function Get_Rep_Spec_Info
(Target_Key_Name : String) return Rep_Specs.Object is
begin
if not Is_Authorized (Rs6000_Target) then
Log.Put_Line
(Message =>
"The " & Rs6000_Target &
" target has not been authorized on this machine.",
Kind => Profile.Error_Msg);
raise Program_Error;
end if;
return Rep_Specs.Build (For_Target => Target_Key_Name);
end Get_Rep_Spec_Info;
end Rci_Semantics;