|
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: 8599 (0x2197)
Types: TextFile
Names: »B«
└─⟦516dceb10⟧ Bits:30000751 8mm tape, Rational 1000, RCI_VADS
└─ ⟦9a14c9417⟧ »DATA«
└─⟦this⟧
with Directory;
with Extensions_Support;
with Object_Set;
with Log;
with Io;
with Profile;
with Set_Generic;
with String_Utilities;
package body View_Support is
package Es renames Extensions_Support;
package Naming renames Directory.Naming;
package Set_Op is new Set_Generic (Directory.Object);
-- Package that supports set operations for a set of
-- directory objects.
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 Unit_List is
-- Convert a set of directory objects into a
-- unit list of directory objects
Units : 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;
procedure Open_Set (For_View : Directory.Object;
Set : in out Object_Set.Set;
Object_Set_Name : String := "referencers";
Status : out Directory.Error_Status) is
Set_Id : Directory.Object;
begin
Set_Id := Es.Get_Object (Directory.Naming.Get_Full_Name
(Es.Get_View (For_View)) &
".state." & Object_Set_Name);
-- Get the referencer set object that is present in
-- every view.
Object_Set.Open (Set_Id => Set_Id, The_Set => Set, Status => Status);
end Open_Set;
procedure Close_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_Set;
function Get_Referencers
(For_View : Directory.Object; Closure : Boolean := False)
return Unit_List is
Closure_Set : Set_Op.Set;
-- Set used to accumalate all units in closure.
This_View : Directory.Object := Es.Get_View (For_View);
-- Current view of the unit
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;
Status : Directory.Error_Status;
begin
Open_Set (For_View => For_View,
Set => Reference_Set,
Object_Set_Name => "referencers",
Status => Status);
if Directory."/=" (Status, Directory.Successful) then
return;
end if;
-- If no referencer set exists return
-- Get the referencer set for this view
--
-- 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 String_Utilities.Equal (Naming.Get_Full_Name (Curr_Obj),
"[VERSION_ERROR]") then
if not Set_Op.Is_Member (Closure_Set, Curr_Obj) then
Set_Op.Add (Closure_Set, Curr_Obj);
if Closure then
Compute_Reference_Closure (Curr_Obj);
end if;
end if;
end if;
Object_Set.Next (Obj_Set_Iter);
end loop;
Close_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 Get_Referencers;
function Get_Imports
(For_View : Directory.Object; Closure : Boolean := False)
return Unit_List is
Closure_Set : Set_Op.Set;
-- Set used to accumalate all units in closure.
This_View : Directory.Object := Es.Get_View (For_View);
-- Current view of the unit
procedure Compute_Import_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;
Import_Set : Object_Set.Set;
Status : Directory.Error_Status;
begin
Open_Set (For_View => For_View,
Set => Import_Set,
Object_Set_Name => "imports",
Status => Status);
if Directory."/=" (Status, Directory.Successful) then
return;
end if;
--
-- FOR each view in the import set of the current view LOOP
-- if view not a member of the import set
-- Add it to the closure set
-- compute_closure (view)
-- end if
-- end loop
--
Object_Set.Init (Iter => Obj_Set_Iter, The_Set => Import_Set);
while not Object_Set.Done (Obj_Set_Iter) loop
Curr_Obj := Object_Set.Value (Obj_Set_Iter);
if not String_Utilities.Equal (Naming.Get_Full_Name (Curr_Obj),
"[VERSION_ERROR]") then
if not Set_Op.Is_Member (Closure_Set, Curr_Obj) then
Set_Op.Add (Closure_Set, Curr_Obj);
if Closure then
Compute_Import_Closure (Curr_Obj);
end if;
end if;
end if;
Object_Set.Next (Obj_Set_Iter);
end loop;
Close_Set (The_Set => Import_Set);
end Compute_Import_Closure;
begin
Set_Op.Initialize (Closure_Set);
-- Initialize the referencer closure set
Compute_Import_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 Get_Imports;
function Is_Member (View_Obj : Directory.Object; View_List : Unit_List)
return Boolean is
begin
if not Simple_Status.Error (View_List.Condition) then
for Index in View_List.Data'First .. View_List.Data'Last loop
if Directory."=" (View_Obj, View_List.Data (Index)) then
return True;
end if;
end loop;
end if;
return False;
end Is_Member;
end View_Support;