|
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: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Extensions_Support, seg_01c364
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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;
nblk1=8
nid=0
hdr6=10
[0x00] rec0=22 rec1=00 rec2=01 rec3=024
[0x01] rec0=1f rec1=00 rec2=02 rec3=010
[0x02] rec0=1d rec1=00 rec2=03 rec3=020
[0x03] rec0=1b rec1=00 rec2=04 rec3=084
[0x04] rec0=19 rec1=00 rec2=05 rec3=04c
[0x05] rec0=1a rec1=00 rec2=06 rec3=01c
[0x06] rec0=1a rec1=00 rec2=07 rec3=018
[0x07] rec0=0c rec1=00 rec2=08 rec3=000
tail 0x21518abd683657239bd87 0x42a00088462060003