|
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 - metrics - download
Length: 11264 (0x2c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Utilities, seg_0045b1, separate Object_Info
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
separate (Object_Info)
package body Utilities is
function Match_Pattern_For (This_Kind : in Kinds) return String is
-- Returns the most constrained naming qualifier that will still
-- return all instances of the specified kind from a naming resolution.
begin
case This_Kind is
when Library =>
return "'C(LIBRARY)";
when Directory =>
return "'C(DIRECTORY)";
when World | Simple_World =>
return "'C(WORLD)";
when Subsystem =>
return "'C(SUBSYSTEM)";
when View =>
return "'C(SPEC_VIEW,LOAD_VIEW,COMBINED_VIEW)";
when Spec_View =>
return "'C(SPEC_VIEW)";
when Load_View |
Working_Load_View |
Released_Load_View |
Code_Only_Load_View =>
return "'C(LOAD_VIEW)";
when Combined_View =>
return "'C(COMBINED_VIEW)";
when Simple_Object =>
return "'C(~LIBRARY)";
when Ada_Unit =>
return "'C(ADA)";
when File =>
return "'C(FILE)";
when Misc_Simple_Object =>
return "'C(~LIBRARY)'C(~ADA)'C(~FILE)";
when others =>
return "";
end case;
end Match_Pattern_For;
function Superset_Objects_In (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Objects is
-- Returns an iterator of objects guaranteed to contain all objects
-- of the desired kind which are contained in the specified object.
-- The iterator may contain extra objects (since there is not a
-- naming expression for every kind of object), which is why this
-- is called "superset". The extra objects need to be removed
-- by some other procedure.
begin
if Transitive then
return Directory_Tools.Naming.Resolution
(Directory_Tools.Naming.Full_Name (This_Object) &
".??" & Utilities.Match_Pattern_For (This_Kind));
else
return Directory_Tools.Naming.Resolution
(Directory_Tools.Naming.Full_Name (This_Object) &
".@" & Utilities.Match_Pattern_For (This_Kind));
end if;
end Superset_Objects_In;
function Is_Same_Kind (This_Object : in Object; This_Kind : in Kinds)
return Boolean is
-- Returns True iff the specified object is of the specified kind.
begin
case This_Kind is
when Anything =>
return True;
when Library =>
return Any.Is_Library (This_Object);
when Directory =>
return Any.Is_Directory (This_Object);
when World =>
return Any.Is_World (This_Object);
when Simple_World =>
return Any.Is_Simple_World (This_Object);
when Subsystem =>
return Any.Is_Subsystem (This_Object);
when Root =>
return Any.Is_Root (This_Object);
when View =>
return Any.Is_View (This_Object);
when Spec_View =>
return Any.Is_Spec_View (This_Object);
when Load_View =>
return Any.Is_Load_View (This_Object);
when Working_Load_View =>
return Any.Is_Working_Load_View (This_Object);
when Released_Load_View =>
return Any.Is_Released_Load_View (This_Object);
when Code_Only_Load_View =>
return Any.Is_Code_Only_Load_View (This_Object);
when Combined_View =>
return Any.Is_Combined_View (This_Object);
when Units_Directory_Of_View =>
return Any.Is_Units_Directory_Of_View (This_Object);
when Simple_Object =>
return Any.Is_Simple_Object (This_Object);
when Ada_Unit =>
return Any.Is_Ada_Unit (This_Object);
when File =>
return Any.Is_File (This_Object);
when Misc_Simple_Object =>
return Any.Is_Misc_Simple_Object (This_Object);
when Frozen =>
return Any.Is_Frozen (This_Object);
when Controlled =>
return Cmvc.Is_Controlled (This_Object);
when Checked_Out =>
return Cmvc.Is_Checked_Out (This_Object);
end case;
end Is_Same_Kind;
function Contains_Objects (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Boolean is
Superset : Objects := Utilities.Superset_Objects_In
(This_Object, This_Kind, Transitive);
begin
Directory_Tools.Object.Reset (Superset);
while not Directory_Tools.Object.Done (Superset) loop
if Utilities.Is_Same_Kind
(Directory_Tools.Object.Value (Superset), This_Kind) then
return True;
end if;
Directory_Tools.Object.Next (Superset);
end loop;
return False;
end Contains_Objects;
function Objects_In (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Objects is
Superset : Objects := Utilities.Superset_Objects_In
(This_Object, This_Kind, Transitive);
The_Objects : Objects := Directory_Tools.Object.Create;
Dummy : Boolean;
begin
Directory_Tools.Object.Reset (Superset);
while not Directory_Tools.Object.Done (Superset) loop
if Utilities.Is_Same_Kind
(Directory_Tools.Object.Value (Superset), This_Kind) then
Directory_Tools.Object.Add
(The_Objects,
Directory_Tools.Object.Value (Superset), Dummy);
end if;
Directory_Tools.Object.Next (Superset);
end loop;
Directory_Tools.Object.Reset (The_Objects);
return The_Objects;
end Objects_In;
function Is_Enclosed (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Boolean is
Current_Library : Any.Library := This_Object;
begin
if Any.Is_Root (This_Object) then
-- Cannot be contained by anything, because already at root.
return False;
else
loop
Current_Library := Directory_Tools.Traversal.
Enclosing_Library (Current_Library);
if Utilities.Is_Same_Kind (Current_Library, This_Kind) then
-- Found an enclosing library of the correct kind.
return True;
elsif Any.Is_Root (Current_Library) then
-- Worked our way all the way up to the root without finding
-- an enclosing object of the correct kind.
return False;
elsif not Transitive then
-- Only supposed to look at first level, so quit.
return False;
end if;
end loop;
end if;
end Is_Enclosed;
function Enclosing_For (This_Object : in Object;
This_Kind : in Kinds;
Transitive : in Boolean) return Object is
Current_Library : Any.Library := This_Object;
begin
if Directory_Tools.Object.Is_Nil (This_Object) then
return Bad_Object;
elsif Any.Is_Root (This_Object) then
-- Cannot be contained by anything, because already at root.
return Bad_Object;
else
loop
Current_Library := Directory_Tools.Traversal.
Enclosing_Library (Current_Library);
if Utilities.Is_Same_Kind (Current_Library, This_Kind) then
-- Found an enclosing library of the correct kind.
return Current_Library;
elsif Any.Is_Root (Current_Library) then
-- Worked our way all the way up to the root without finding
-- an enclosing object of the correct kind.
return Bad_Object;
elsif not Transitive then
-- Only supposed to look at first level, so quit.
return Bad_Object;
end if;
end loop;
end if;
end Enclosing_For;
end Utilities;
nblk1=a
nid=0
hdr6=14
[0x00] rec0=1d rec1=00 rec2=01 rec3=020
[0x01] rec0=17 rec1=00 rec2=02 rec3=030
[0x02] rec0=1a rec1=00 rec2=03 rec3=026
[0x03] rec0=16 rec1=00 rec2=04 rec3=032
[0x04] rec0=17 rec1=00 rec2=05 rec3=036
[0x05] rec0=19 rec1=00 rec2=06 rec3=01c
[0x06] rec0=1a rec1=00 rec2=07 rec3=032
[0x07] rec0=16 rec1=00 rec2=08 rec3=066
[0x08] rec0=15 rec1=00 rec2=09 rec3=052
[0x09] rec0=09 rec1=00 rec2=0a rec3=000
tail 0x21700214c815c654a4ef5 0x42a00088462061e03