|
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 - metrics - downloadIndex: B T
Length: 11120 (0x2b70)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
separate (Object_Info)
package body Ada is
function Is_Installed (This_Unit : in Ada_Unit) return Boolean is
begin
return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then
(Directory_Tools.Ada_Object.State (This_Unit) =
Directory_Tools.Ada_Object.Installed));
end Is_Installed;
function Is_Coded (This_Unit : in Ada_Unit) return Boolean is
begin
return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then
(Directory_Tools.Ada_Object.State (This_Unit) =
Directory_Tools.Ada_Object.Coded));
end Is_Coded;
function Is_Installed_Or_Coded (This_Unit : in Ada_Unit) return Boolean is
begin
return ((Directory_Tools.Ada_Object.State (This_Unit) =
Directory_Tools.Ada_Object.Installed) or else
(Directory_Tools.Ada_Object.State (This_Unit) =
Directory_Tools.Ada_Object.Coded));
end Is_Installed_Or_Coded;
function Is_Body (This_Unit : in Ada_Unit) return Boolean is
--
Unit_Kind : Directory_Tools.Ada_Object.Unit_Kind :=
Directory_Tools.Ada_Object.Kind (This_Unit);
--
begin
return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then
(not Object_Info.Ada.Is_Subunit (This_Unit)) and then
((Unit_Kind = Directory_Tools.Ada_Object.Package_Body) or else
(Unit_Kind = Directory_Tools.Ada_Object.Procedure_Body) or else
(Unit_Kind = Directory_Tools.Ada_Object.Function_Body)));
end Is_Body;
function Is_Subunit (This_Unit : in Ada_Unit) return Boolean is
--
Compilation_Kind : Directory_Tools.Ada_Object.Compilation_Kind :=
Directory_Tools.Ada_Object.Kind (This_Unit);
--
begin
return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then
(Compilation_Kind = Directory_Tools.Ada_Object.Subunit));
end Is_Subunit;
function Is_Body_Or_Subunit (This_Unit : in Ada_Unit) return Boolean is
begin
return ((Object_Info.Ada.Is_Body (This_Unit)) or else
(Object_Info.Ada.Is_Subunit (This_Unit)));
end Is_Body_Or_Subunit;
function Is_Spec (This_Unit : in Ada_Unit) return Boolean is
begin
return ((Object_Info.Any.Is_Ada_Unit (This_Unit)) and then
(Directory_Tools.Ada_Object.Is_Visible_Part (This_Unit)));
end Is_Spec;
function Is_Universe_Mirror (This_Unit : in Ada_Unit) return Boolean is
--
The_Root : Standard.Directory.Ada.Root;
The_Status : Standard.Directory.Error_Status;
Object_Id : Diana.Tree;
Pragmas : Diana.Sequence;
--
begin
if (Object_Info.Ada.Is_Spec (This_Unit)) then
-- Find the root of the object.
Directory_Tools.Object.Low_Level.Get_Root
(This_Unit, The_Root, The_Status);
-- Get the id for the object.
Object_Id := Diana.Id_Utilities.Comp_Unit_Id (The_Root);
if (Semantic_Attributes.Has_Sm_Subsystem_Interface (Object_Id)) then
-- Since is subsystem interface, see if has a pragma
-- for Module_Name in it: if so, it is a universe mirror.
Pragmas := Semantic_Attributes.Sm_Applied_Pragmas (Object_Id);
while (not Diana.Is_Empty (Pragmas)) loop
if (String_Utilities.Upper_Case
(Diana.Image (Diana.Id
(Diana.As_Id (Diana.Head
(Pragmas))))) =
"MODULE_NAME") then
return (True);
end if;
Pragmas := Diana.Tail (Pragmas);
end loop;
end if;
end if;
return (False);
--
exception
when others =>
return (False);
--
end Is_Universe_Mirror;
function Is_Generic_Spec (This_Unit : in Ada_Unit) return Boolean is
--
Object_Kind : Directory_Tools.Ada_Object.Unit_Kind :=
Directory_Tools.Ada_Object.Kind (This_Unit);
--
begin
return ((Object_Info.Ada.Is_Spec (This_Unit)) and then
((Object_Kind = Directory_Tools.Ada_Object.
Generic_Package) or else
(Object_Kind = Directory_Tools.Ada_Object.
Generic_Procedure) or else
(Object_Kind = Directory_Tools.Ada_Object.
Generic_Function)));
end Is_Generic_Spec;
function Is_Spec_In_Spec_View (This_Unit : in Ada_Unit) return Boolean is
begin
return ((Object_Info.Ada.Is_Spec (This_Unit)) and then
(Object_Info.Any.Is_Contained_By_Spec_View (This_Unit)));
end Is_Spec_In_Spec_View;
function Is_Spec_In_Load_View (This_Unit : in Ada_Unit) return Boolean is
begin
return ((Object_Info.Ada.Is_Spec (This_Unit)) and then
(Object_Info.Any.Is_Contained_By_Load_View (This_Unit)));
end Is_Spec_In_Load_View;
function Matching_Spec
(Current_Spec : in Ada_Spec;
Current_View : in Object_Info.Any.View;
Other_View : in Object_Info.Any.View) return Ada_Spec is
begin
declare
--
Current_Spec_Name : constant String :=
Directory_Tools.Naming.Full_Name (Current_Spec);
Current_View_Name : constant String :=
Directory_Tools.Naming.Full_Name (Current_View);
Current_Tail : constant String :=
Current_Spec_Name ((Current_Spec_Name'First +
Current_View_Name'Length) ..
Current_Spec_Name'Last);
--
Other_View_Name : constant String :=
Directory_Tools.Naming.Full_Name (Other_View);
Other_Spec_Name : constant String := Other_View_Name & Current_Tail;
--
Other_Spec : Ada_Spec :=
Directory_Tools.Naming.Resolution (Other_Spec_Name);
--
begin
return (Other_Spec);
end;
--
exception
when others =>
return (Object_Info.Utilities.Bad_Object);
--
end Matching_Spec;
function Spec_In_Other_View
(This_Spec : in Ada_Spec;
This_Activity : in Activity.Activity_Name :=
Activity.The_Current_Activity) return Ada_Spec is
--
Current_View : Object_Info.Any.View :=
Object_Info.Any.View_Containing (This_Spec);
--
begin
if (Object_Info.Any.Is_Spec_View (Current_View)) then
return (Matching_Spec
(Current_Spec => This_Spec,
Current_View => Current_View,
Other_View =>
Object_Info.Cmvc.Current_Load_View_In
(Object_Info.Any.Subsystem_Containing
(Current_View), This_Activity)));
elsif (Object_Info.Any.Is_Load_View (Current_View)) then
return (Matching_Spec
(Current_Spec => This_Spec,
Current_View => Current_View,
Other_View =>
Object_Info.Cmvc.Current_Spec_View_In
(Object_Info.Any.Subsystem_Containing
(Current_View), This_Activity)));
elsif (Object_Info.Any.Is_Combined_View (Current_View)) then
return (This_Spec);
else
return (Object_Info.Utilities.Bad_Object);
end if;
--
exception
when others =>
return (Object_Info.Utilities.Bad_Object);
--
end Spec_In_Other_View;
function Specs_Withed_By (This_Unit : in Ada_Unit) return Ada_Specs is
begin
return (Directory_Tools.Ada_Object.List_Of_Withs (This_Unit));
end Specs_Withed_By;
function Dependents_Of (This_Unit : in Ada_Unit) return Ada_Units is
begin
return (Directory_Tools.Ada_Object.Depends_On (This_Unit));
end Dependents_Of;
function Parent_Of (This_Unit : in Ada_Unit) return Ada_Unit is
begin
if (Object_Info.Ada.Is_Spec (This_Unit)) then
return (Object_Info.Utilities.Bad_Object);
elsif (Object_Info.Ada.Is_Body (This_Unit)) then
return (Directory_Tools.Ada_Object.Other_Part (This_Unit));
elsif (Object_Info.Ada.Is_Subunit (This_Unit)) then
return (Directory_Tools.Traversal.Parent (This_Unit));
end if;
--
exception
when others =>
return (Object_Info.Utilities.Bad_Object);
--
end Parent_Of;
function Subunits_Of (This_Unit : in Ada_Unit) return Subunits is
begin
return (Directory_Tools.Ada_Object.Subunits
(This_Unit, Declared => False));
end Subunits_Of;
function Body_For (This_Unit : in Ada_Unit) return Ada_Body is
--
Current_Unit : Ada_Unit := This_Unit;
--
begin
if (Object_Info.Ada.Is_Spec (Current_Unit)) then
-- Find body associated with spec.
Current_Unit :=
Directory_Tools.Ada_Object.Other_Part (Current_Unit);
elsif (Object_Info.Ada.Is_Subunit (Current_Unit)) then
-- Find parents transitively until get to body.
while (Directory_Tools.Ada_Object.Is_Subunit (Current_Unit)) loop
Current_Unit := Object_Info.Ada.Parent_Of (Current_Unit);
end loop;
end if;
if (not Object_Info.Ada.Is_Body (Current_Unit)) then
-- Something went wrong.
return (Object_Info.Utilities.Bad_Object);
else
return (Current_Unit);
end if;
--
exception
when others =>
return (Object_Info.Utilities.Bad_Object);
--
end Body_For;
function Spec_For (This_Unit : in Ada_Unit) return Ada_Spec is
--
Current_Unit : Ada_Unit := This_Unit;
--
begin
-- Find parents transitively until get to body.
while (Directory_Tools.Ada_Object.Is_Subunit (Current_Unit)) loop
Current_Unit := Object_Info.Ada.Parent_Of (Current_Unit);
end loop;
if (Object_Info.Ada.Is_Body (Current_Unit)) then
-- Find spec associated with body.
Current_Unit := Object_Info.Ada.Parent_Of (Current_Unit);
end if;
if (not Object_Info.Ada.Is_Spec (Current_Unit)) then
-- Something went wrong.
return (Object_Info.Utilities.Bad_Object);
else
return (Current_Unit);
end if;
--
exception
when others =>
return (Object_Info.Utilities.Bad_Object);
--
end Spec_For;
end Ada;