|
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: 7133 (0x1bdd)
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 Object_Set;
with Object_Subclass;
with Profile;
with Set_Generic;
with Simple_Status;
package body Extensions_Support is
function "=" (L, R : Directory.Subclass) return Boolean
renames Directory."=";
function Is_View (Obj : Directory.Object) return Boolean is
Subclass : Directory.Subclass := Directory.Get_Subclass (Obj);
begin
return (Subclass = Object_Subclass.Spec_View_Subclass) or else
(Subclass = Object_Subclass.Load_View_Subclass) or else
(Subclass = Object_Subclass.Combined_View_Subclass);
end Is_View;
function Get_View (Object : Directory.Object) return Directory.Object is
N_Status : Naming.Name_Status;
Obj : Directory.Object := Object;
E_Status : Directory.Error_Status;
Obj_Unit : Directory.Ada.Unit;
begin
if Is_View (Obj) then
return Obj;
end if;
Directory.Control_Point.Enclosing_World (Obj, Obj_Unit, E_Status);
if Directory."/=" (E_Status, Directory.Successful) then
return Directory.Nil;
end if;
Obj := Directory.Ada.Get_Object (Obj_Unit);
if Is_View (Obj) then
return Obj;
else
return Directory.Nil;
end if;
-- if you are here, an error occurred
return Directory.Nil;
end Get_View;
function Get_View (Object_Name : String) return Directory.Object is
Obj : Directory.Object;
Status : Naming.Name_Status;
begin
Naming.Resolve (Object_Name, Obj, Status);
if Naming."/=" (Status, Naming.Successful) then
Log.Put_Line (Object_Name & " not found", Profile.Warning_Msg);
return Directory.Nil;
end if;
return Get_View (Obj);
end Get_View;
function Get_Object (Object_Name : String) return Directory.Object is
Obj : Directory.Object;
Status : Naming.Name_Status;
begin
Naming.Resolve (Object_Name, Obj, Status);
if Naming."/=" (Status, Naming.Successful) then
return Directory.Nil;
end if;
return Obj;
end Get_Object;
function Compute_Reference_Closure
(For_View : Directory.Object) return Ci.Unit_List is
-- Computes the compilation closure of a given unit
package Set_Op is new Set_Generic (Directory.Object);
-- Package that supports set operations for a set of
-- directory objects.
Closure_Set : Set_Op.Set;
-- Set used to accumalate all units in closure.
This_View : Directory.Object := Get_View (For_View);
-- Current view of the unit
function Element_Count (S : Set_Op.Set) return Integer is
-- Returns the cardinality of the set
Element_Iter : Set_Op.Iterator;
Count : Integer := 0;
begin
Set_Op.Init (Element_Iter, S);
-- Initialize the set iterator
while not Set_Op.Done (Element_Iter) loop
Count := Count + 1;
Set_Op.Next (Element_Iter);
end loop;
-- Count all the elements in the set
return Count;
end Element_Count;
function To_Unit_List (S : Set_Op.Set; Element_Count : Integer)
return Ci.Unit_List is
-- Convert a set of directory objects into a
-- unit list of directory objects
Units : Ci.Unit_List (Element_Count);
Element_Iter : Set_Op.Iterator;
Index : Integer := 1;
begin
Set_Op.Init (Element_Iter, S);
-- Initialize the set iterator
while not Set_Op.Done (Element_Iter) loop
Units.Data (Index) := Set_Op.Value (Element_Iter);
Index := Index + 1;
Set_Op.Next (Element_Iter);
end loop;
-- Collect each element in the set into the unit_list
-- array
Simple_Status.Create_Condition
(Units.Condition, "", "", Simple_Status.Normal);
return Units;
exception
when others =>
Simple_Status.Create_Condition
(Units.Condition, "", "", Simple_Status.Problem);
return Units;
end To_Unit_List;
function Open_Referencer_Set
(For_View : Directory.Object) return Object_Set.Set is
Ref_Set : Object_Set.Set;
Set_Id : Directory.Object;
Status : Directory.Error_Status;
begin
Set_Id := Get_Object (Naming.Get_Full_Name (Get_View (For_View)) &
".state.referencers");
-- Get the referencer set object that is present in
-- every view.
Object_Set.Open (Set_Id => Set_Id,
The_Set => Ref_Set,
Status => Status);
-- Open the referencer set
return Ref_Set;
end Open_Referencer_Set;
procedure Close_Referencer_Set (The_Set : Object_Set.Set) is
Status : Directory.Error_Status;
begin
Object_Set.Close (The_Set => The_Set, Status => Status);
-- Close the referencer set object
end Close_Referencer_Set;
procedure Compute_Reference_Closure (For_View : Directory.Object) is
-- Given a unit this procedure computes the compilation
-- closure of these
Curr_Obj : Directory.Object;
Obj_Set_Iter : Object_Set.Iterator;
Reference_Set : Object_Set.Set :=
Open_Referencer_Set (For_View => For_View);
-- Get the referencer set for this view
begin
--
-- FOR each view in the reference set of the current view LOOP
-- if view not a member of the closure set
-- Add it to the closure set
-- compute_closure (view)
-- end if
-- end loop
--
Object_Set.Init (Iter => Obj_Set_Iter, The_Set => Reference_Set);
while not Object_Set.Done (Obj_Set_Iter) loop
Curr_Obj := Object_Set.Value (Obj_Set_Iter);
if not Set_Op.Is_Member (Closure_Set, Curr_Obj) then
Set_Op.Add (Closure_Set, Curr_Obj);
Compute_Reference_Closure (Curr_Obj);
end if;
Object_Set.Next (Obj_Set_Iter);
end loop;
Close_Referencer_Set (The_Set => Reference_Set);
end Compute_Reference_Closure;
begin
Set_Op.Initialize (Closure_Set);
-- Initialize the referencer closure set
Compute_Reference_Closure (For_View => For_View);
-- Compute the closure set of the specified unit object
return To_Unit_List (Closure_Set, Element_Count (Closure_Set));
-- Convert the closure set to a directory object list and return.
end Compute_Reference_Closure;
end Extensions_Support;