DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦81c20e74c⟧ Ada Source

    Length: 25600 (0x6400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Cmvc, seg_0045af, separate Object_Info

Derivation

└─⟦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 Cmvc is

    --[BE CAREFUL NOT TO INTRODUCE MUTUAL RECURSION]
    --[BETWEEN THIS PACKAGE AND OBJECT_INFO.LINKS  ]

    function "=" (This_Error_Status : in Standard.Directory.Error_Status;
                  That_Error_Status : in Standard.Directory.Error_Status)
                 return Boolean renames Standard.Directory."=";

    function "=" (This_Error_Status : in Standard.Directory.Naming.Name_Status;
                  That_Error_Status : in Standard.Directory.Naming.Name_Status)
                 return Boolean renames Standard.Directory.Naming."=";

    function Model_For (This_View : in View) return Model_World is

        View_Model_Database_Name : constant String :=
           Directory_Tools.Naming.Full_Name (This_View) & ".STATE.MODEL";

        View_Model_Database : Standard.Directory.Object;

        View_Model_Set : Object_Set.Set;

        View_Model_Iterator : Object_Set.Iterator;

        View_Model : Standard.Directory.Object;

        Error_Status : Standard.Directory.Error_Status;
        Name_Status  : Standard.Directory.Naming.Name_Status;

        The_Model : Model_World;

    begin
        if Any.Is_Bad (This_View) then
            return Utilities.Bad_Object;
        end if;
        if not Any.Is_View (This_View) then
            return Utilities.Bad_Object;
        end if;
        Standard.Directory.Naming.Resolve (View_Model_Database_Name,
                                           View_Model_Database, Name_Status);
        if Name_Status /= Standard.Directory.Naming.Successful then
            return Utilities.Bad_Object;
        end if;
        Object_Set.Open (View_Model_Database, View_Model_Set, Error_Status);
        if Error_Status /= Standard.Directory.Successful then
            return Utilities.Bad_Object;
        end if;
        Object_Set.Init (View_Model_Iterator, View_Model_Set);
        View_Model := Object_Set.Value (Vew_Model_Iterator);
        The_Model  := Directory_Tools.Naming.Resolution
                         (Standard.Directory.Naming.Get_Full_Name (View_Model));
        if Any.Is_Bad (The_Model) then
            return Utilities.Bad_Object;
        end if;
        Object_Set.Close (The_Set => View_Model_Set, Status => Error_Status);
        return The_Model;

    exception
        when others =>
            return Utilities.Bad_Object;

    end Model_For;

    function Models_Equal (This_View : in View; This_Model : in Model_World)
                          return Boolean is
    begin
        if not Any.Is_Good (This_Model) then
            return False;
        end if;
        if not Any.Is_Simple_World (This_Model) then
            return False;
        end if;
        return Directory_Tools.Naming.Full_Name (Cmvc.Model_For (This_View)) =
                  Directory_Tools.Naming.Full_Name (This_Model);
    exception
        when others =>
            return False;

    end Models_Equal;

    function Is_Primary (This_Subsystem : in Subsystem) return Boolean is

        -- Necessary because there is no subclass.

        The_Info_File : Io.File_Type;

    begin
        Io.Open (The_Info_File, Io.In_File,
                 Directory_Tools.Naming.Full_Name (This_Subsystem) &
                    ".STATE.COMPATIBILITY.STATE");
        declare
            The_Entry : constant String := Io.Get_Line (The_Info_File);
        begin  
            Io.Close (The_Info_File);
            return The_Entry = "PRIMARY => TRUE";
        end;

    exception
        when others =>
            Io.Close (The_Info_File);
            return False;

    end Is_Primary;

    function Is_Secondary (This_Subsystem : in Subsystem) return Boolean is
    begin
        return not Cmvc.Is_Primary (This_Subsystem);
    end Is_Secondary;

    function Is_Controlled (This_Object : in Object) return Boolean is

        function "=" (This_Error_Status : in Standard.Directory.Error_Status;
                      That_Error_Status : in Standard.Directory.Error_Status)
                     return Boolean renames Standard.Directory."=";

        The_Object : Standard.Directory.Object;
        The_Status : Standard.Directory.Error_Status;

        Object_Is_Controlled : Boolean := False;

    begin
        Directory_Tools.Object.Low_Level.Get_Object
           (This_Object, The_Object, The_Status);
        Standard.Directory.Object_Operations.Is_Controlled
           (The_Object, Object_Is_Controlled, The_Status);
        return (The_Status = Standard.Directory.Successful) and then
                  Object_Is_Controlled;
    end Is_Controlled;

    function Is_Checked_Out (This_Object : in Object) return Boolean is

        function "=" (This_Error_Status : in Standard.Directory.Error_Status;
                      That_Error_Status : in Standard.Directory.Error_Status)
                     return Boolean renames Standard.Directory."=";

        The_Object : Standard.Directory.Object;
        The_Status : Standard.Directory.Error_Status;

        Object_Is_Checked_In : Boolean;

    begin
        Directory_Tools.Object.Low_Level.Get_Object
           (This_Object, The_Object, The_Status);
        Standard.Directory.Object_Operations.Is_Slushy
           (The_Object, Object_Is_Checked_In, The_Status);
        return (The_Status = Standard.Directory.Successful) and then
                  not Any.Is_Library (This_Object) and then
                  Cmvc.Is_Controlled (This_Object) and then  
                  not Object_Is_Checked_In;
    end Is_Checked_Out;

    function Contains_Controlled_Objects
                (This_Object : in Object; Transitive : in Boolean := True)
                return Boolean is
    begin
        return Utilities.Contains_Objects
                  (This_Object, Utilities.Controlled, Transitive);
    end Contains_Controlled_Objects;

    function Contains_Checked_Out_Objects
                (This_Object : in Object; Transitive : in Boolean := True)
                return Boolean is
    begin
        return Utilities.Contains_Objects
                  (This_Object, Utilities.Checked_Out, Transitive);
    end Contains_Checked_Out_Objects;

    function Controlled_Objects_In
                (This_Object : in Object; Transitive : in Boolean := True)
                return Controlled_Objects is
    begin
        return Utilities.Objects_In
                  (This_Object, Utilities.Controlled, Transitive);
    end Controlled_Objects_In;

    function Checked_Out_Objects_In
                (This_Object : in Object; Transitive : in Boolean := True)
                return Checked_Out_Objects is
    begin
        return Utilities.Objects_In
                  (This_Object, Utilities.Checked_Out, Transitive);
    end Checked_Out_Objects_In;

    function Current_Spec_View_In
                (This_Subsystem : in Subsystem;
                 This_Activity  : in Activity.Activity_Name :=
                    Activity.The_Current_Activity) return Spec_View is

        Subsystem_Id    : Activity_Implementation.Subsystem_Id;
        Activity_Id     : Activity_Implementation.Activity_Id;
        Activity_Handle : Activity_Implementation.Activity_Handle;
        Name_Status     : Standard.Directory.Naming.Name_Status;
        Error_Status    : Standard.Directory.Error_Status;
        Spec_Id         : Activity_Implementation.Spec_View_Id;
        The_Spec_View   : Directory_Tools.Object.Handle;

    begin
        Standard.Directory.Naming.Resolve
           (Directory_Tools.Naming.Full_Name (This_Subsystem),
            Subsystem_Id, Name_Status);
        Standard.Directory.Naming.Resolve
           (This_Activity, Activity_Id, Name_Status);
        Activity_Implementation.Open
           (Activity_Id, Activity_Handle, Error_Status);
        Spec_Id := Activity_Implementation.Get_Spec_View
                      (Subsystem_Id, Activity_Handle);
        Activity_Implementation.Close (Activity_Handle, Error_Status);
        The_Spec_View := Directory_Tools.Naming.Resolution
                            (Standard.Directory.Naming.Get_Full_Name (Spec_Id));
        return The_Spec_View;

    exception
        when others =>
            return Utilities.Bad_Object;

    end Current_Spec_View_In;

    function Current_Load_View_In
                (This_Subsystem : in Subsystem;
                 This_Activity  : in Activity.Activity_Name :=
                    Activity.The_Current_Activity) return Load_View is

        Subsystem_Id    : Activity_Implementation.Subsystem_Id;
        Activity_Id     : Activity_Implementation.Activity_Id;
        Activity_Handle : Activity_Implementation.Activity_Handle;
        Name_Status     : Standard.Directory.Naming.Name_Status;
        Error_Status    : Standard.Directory.Error_Status;
        Load_Id         : Activity_Implementation.Load_View_Id;
        The_Load_View   : Directory_Tools.Object.Handle;

    begin
        Standard.Directory.Naming.Resolve
           (Directory_Tools.Naming.Full_Name (This_Subsystem),
            Subsystem_Id, Name_Status);
        Standard.Directory.Naming.Resolve
           (This_Activity, Activity_Id, Name_Status);
        Activity_Implementation.Open
           (Activity_Id, Activity_Handle, Error_Status);
        Load_Id := Activity_Implementation.Get_Load_View
                      (Subsystem_Id, Activity_Handle);
        Activity_Implementation.Close (Activity_Handle, Error_Status);
        The_Load_View := Directory_Tools.Naming.Resolution
                            (Standard.Directory.Naming.Get_Full_Name (Load_Id));
        return The_Load_View;

    exception
        when others =>
            return Utilities.Bad_Object;

    end Current_Load_View_In;

    function Imports_For (This_View : in View; Used_Only : in Boolean := True)
                         return Imports is

        The_Imports : Imports := Directory_Tools.Object.Create;

        Imports_Database_Name : constant String :=
           Directory_Tools.Naming.Full_Name (This_View) & ".STATE.IMPORTS";

        Imports_Database : Standard.Directory.Object;

        Imports_Set : Object_Set.Set;

        Imports_Iterator : Object_Set.Iterator;

        Error_Status : Standard.Directory.Error_Status;
        Name_Status  : Standard.Directory.Naming.Name_Status;

    begin
        if not Any.Is_Good (This_View) then
            return Utilities.Bad_Objects;
        end if;
        if not Any.Is_View (This_View) then
            return Utilities.Bad_Objects;
        end if;
        Standard.Directory.Naming.Resolve
           (Imports_Database_Name, Imports_Database, Name_Status);
        if Name_Status /= Standard.Directory.Naming.Successful then
            return Utilities.Bad_Objects;
       end if;
        Object_Set.Open (Imports_Database, Imports_Set, Error_Status);
        if Error_Status /= Standard.Directory.Successful then
            return Utilities.Bad_Objects;
        end if;
        Object_Set.Init (Imports_Iterator, Imports_Set);
        while not Object_Set.Done (Imports_Iterator) loop
            declare
                The_Import_Object : Standard.Directory.Object :=
                   Object_Set.Value (Imports_Iterator);
                The_Import_Object_Name : constant String :=
                   Standard.Directory.Naming.Get_Full_Name (The_Import_Object);
                The_Import : Import := Directory_Tools.Naming.Resolution
                                          (The_Import_Object_Name);
                Dummy : Boolean;
            begin  
                if Any.Is_Good (The_Import) then  
                    if Used_Only then
                        if Cmvc.Is_Used (The_Import, This_View) then
                            Directory_Tools.Object.Add
                               (The_Imports, The_Import, Dummy);
                        end if;
                    else
                        Directory_Tools.Object.Add
                           (The_Imports, The_Import, Dummy);
                    end if;
                end if;
            end;
            Object_Set.Next (Imports_Iterator);
        end loop;
        Object_Set.Close (The_Set => Imports_Set, Status => Error_Status);
        return The_Imports;

    exception
        when others =>
            return Utilities.Bad_Objects;

    end Imports_For;

    function Is_Used (This_Import : in Import; By_View : in View)
                     return Boolean is

        Imported_Links : Links.Imported_External_Links :=
           Links.Links_Derived_From  
              (This_Import => This_Import,
               Into_View   => By_View,
               Used_Only   => True);
    begin
        return not Any.Is_Empty (Imported_Links);
    end Is_Used;

    function Referencers_Of
                (This_Spec_View : in Spec_View; Using_Only : in Boolean := True)
                return Referencers is

        The_Referencers : Referencers := Directory_Tools.Object.Create;

        Referencers_Database_Name : constant String :=
           Directory_Tools.Naming.Full_Name (This_Spec_View) &
              ".STATE.REFERENCERS";

        Referencers_Database : Standard.Directory.Object;

        Referencers_Set : Object_Set.Set;

        Referencers_Iterator : Object_Set.Iterator;

        Error_Status : Standard.Directory.Error_Status;
        Name_Status  : Standard.Directory.Naming.Name_Status;

    begin
        if not Any.Is_Good (This_Spec_View) then
            return Utilities.Bad_Objects;
        end if;
        if not Any.Is_View (This_Spec_View) then
            return Utilities.Bad_Objects;
        end if;
        Standard.Directory.Naming.Resolve (Rferencers_Database_Name,
                                           Referencers_Database, Name_Status);
        if Name_Status /= Standard.Directory.Naming.Successful then
            return Utilities.Bad_Objects;
        end if;
        Object_Set.Open (Referencers_Database, Referencers_Set, Error_Status);
        if Error_Status /= Standard.Directory.Successful then
            return Utilities.Bad_Objects;
        end if;
        Object_Set.Init (Referencers_Iterator, Referencers_Set);
        while not Object_Set.Done (Referencers_Iterator) loop
            declare
                The_Referencer_Object : Standard.Directory.Object :=
                   Object_Set.Value (Referencers_Iterator);
                The_Referencer_Object_Name : constant String :=
                   Standard.Directory.Naming.Get_Full_Name
                      (The_Referencer_Object);
                The_Referencer : Referencer := Directory_Tools.Naming.Resolution
                                                  (The_Referencer_Object_Name);
                Dummy : Boolean;
            begin  
                if Any.Is_Good (The_Referencer) then
                    if Using_Only then
                        if Cmvc.Is_User (The_Referencer, This_Spec_View) then
                            Directory_Tools.Object.Add
                               (The_Referencers, The_Referencer, Dummy);
                        end if;
                    else
                        Directory_Tools.Object.Add
                           (The_Referencers, The_Referencer, Dummy);
                    end if;
                end if;
            end;
            Object_Set.Next (Referencers_Iterator);
        end loop;
        Object_Set.Close (The_Set => Referencers_Set, Status => Error_Status);
        return The_Referencers;

    exception
        when others =>
            return Utilities.Bad_Objects;

    end Referencers_Of;

    function Is_User (This_Referencer : in Referencer;
                      Of_Spec_View    : in Spec_View) return Boolean is

        Imported_Links : Links.Imported_External_Links :=
           Links.Links_Derived_From  
              (This_Import => Of_Spec_View,
               Into_View   => This_Referencer,
               Used_Only   => True);
    begin
        return not Any.Is_Empty (Imported_Links);
    end Is_User;

end Cmvc;

    nblk1=18
    nid=0
    hdr6=30
        [0x00] rec0=1b rec1=00 rec2=01 rec3=018
        [0x01] rec0=18 rec1=00 rec2=02 rec3=052
        [0x02] rec0=00 rec1=00 rec2=18 rec3=002
        [0x03] rec0=1c rec1=00 rec2=03 rec3=014
        [0x04] rec0=00 rec1=00 rec2=17 rec3=004
        [0x05] rec0=23 rec1=00 rec2=04 rec3=00c
        [0x06] rec0=16 rec1=00 rec2=05 rec3=012
        [0x07] rec0=18 rec1=00 rec2=06 rec3=014
        [0x08] rec0=1a rec1=00 rec2=07 rec3=02e
        [0x09] rec0=14 rec1=00 rec2=08 rec3=06e
        [0x0a] rec0=01 rec1=00 rec2=16 rec3=028
        [0x0b] rec0=16 rec1=00 rec2=09 rec3=06a
        [0x0c] rec0=01 rec1=00 rec2=15 rec3=00c
        [0x0d] rec0=18 rec1=00 rec2=0a rec3=058
        [0x0e] rec0=00 rec1=00 rec2=14 rec3=014
        [0x0f] rec0=1c rec1=00 rec2=0b rec3=008
        [0x10] rec0=00 rec1=00 rec2=13 rec3=002
        [0x11] rec0=13 rec1=00 rec2=0c rec3=03a
        [0x12] rec0=1d rec1=00 rec2=0d rec3=036
        [0x13] rec0=1d rec1=00 rec2=0e rec3=058
        [0x14] rec0=00 rec1=00 rec2=12 rec3=002
        [0x15] rec0=12 rec1=00 rec2=0f rec3=032
        [0x16] rec0=1a rec1=00 rec2=10 rec3=034
        [0x17] rec0=0d rec1=00 rec2=11 rec3=000
    tail 0x217002148815c65459084 0x42a00088462061e03