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 - metrics - download

⟦a537cb99c⟧ Ada Source

    Length: 10240 (0x2800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Install_Customization, seg_014291

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with Activity;
with Archive;
with Debug_Tools;  
with Directory_Tools;
with Log;
with Links;
with Profile;
with Program;
with String_Utilities;

procedure Install_Customization (Target_Key : String := "<DEFAULT>";
                                 Release_Number : String := "<DEFAULT>";
                                 Version : String := "<DEFAULT>") is
    Bad_Current_Context : exception;

    Def_Con : constant String := Directory_Tools.Naming.Default_Context;

    Install_World_Prefix : constant String := "!Targets.Implementation.Release";

    function Default_Release_Suffix return String is
    begin
        if Install_World_Prefix'Length < Def_Con'Length and then
           String_Utilities.Equal
              (Install_World_Prefix,
               Def_Con (Def_Con'First ..
                           Def_Con'First + Install_World_Prefix'Length - 1),
               Ignore_Case => True) then
            return Def_Con (Def_Con'First + Install_World_Prefix'Length ..
                               Def_Con'Last);

        else

            raise Bad_Current_Context;

        end if;
    end Default_Release_Suffix;

    function Get_Target_Key return String is
    begin
        if String_Utilities.Equal
              (Release_Number, "<DEFAULT>", Ignore_Case => True) then
            declare
                Release_Suffix : constant String := Default_Release_Suffix;
                Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_", Within => Release_Suffix);
                Second_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix (Release_Suffix'First ..
                                                    Last_Underscore - 1));


                Third_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix
                                    (Release_Suffix'First ..
                                        Second_To_Last_Underscore - 1));


            begin
                if Third_To_Last_Underscore > Release_Suffix'First then
                    return Release_Suffix (Release_Suffix'First + 1 ..
                                              Third_To_Last_Underscore - 1);
                else
                    raise Bad_Current_Context;
                end if;
            end;
        else
            return Release_Number;
        end if;
    end Get_Target_Key;

    function Get_Release_Number return String is
    begin
        if String_Utilities.Equal
              (Release_Number, "<DEFAULT>", Ignore_Case => True) then
            declare
                Release_Suffix : constant String := Default_Release_Suffix;
                Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_", Within => Release_Suffix);
                Second_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix (Release_Suffix'First ..
                                                    Last_Underscore - 1));
                Third_To_Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_",
                       Within => Release_Suffix
                                    (Release_Suffix'First ..
                                        Second_To_Last_Underscore - 1));

            begin
                if Third_To_Last_Underscore > Release_Suffix'First then
                    return Release_Suffix (Third_To_Last_Underscore + 1 ..
                                              Last_Underscore - 1);
                else
                    raise Bad_Current_Context;
                end if;
            end;
        else
            return Release_Number;
        end if;
    end Get_Release_Number;

    function Get_Version return String is
    begin
        if String_Utilities.Equal
              (Version, "<DEFAULT>", Ignore_Case => True) then
            declare
                Release_Suffix : constant String := Default_Release_Suffix;
                Last_Underscore : constant Integer :=
                   String_Utilities.Reverse_Locate
                      (Fragment => "_", Within => Release_Suffix);
            begin
                if Last_Underscore > Release_Suffix'First then
                    return Release_Suffix
                              (Last_Underscore .. Release_Suffix'Last);
                else
                    raise Bad_Current_Context;
                end if;
            end;
        else
            return Version;
        end if;
    end Get_Version;

    function Release_World return String is
    begin
        return "!targets.implementation.release_" & Get_Target_Key &
                  "_" & Get_Release_Number & Get_Version;
    end Release_World;

    procedure Restore_Predefined is
    begin
        Log.Put_Line ("Restoring predefined world");
        Archive.Restore (Objects => "[?,~!Targets." & Get_Target_Key & "]",
                         Use_Prefix => "*",
                         For_Prefix => "*",
                         Options => "changed_objects replace",
                         Device => Release_World & ".predefined_archive",
                         Response => "<PROFILE>");
        Log.Put_Line ("Successfully restored predefined world");
    exception
        when others =>
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Restore_Predefined",
                          Kind => Profile.Error_Msg);  
            raise;
    end Restore_Predefined;


    procedure Merge_Activities is
    begin
        Log.Put_Line
           ("Merging " & Release_World &
            ".install_activity into !machine.release.current.activity");
        Activity.Merge (Source => Release_World & ".install_activity",
                        Subsystem => "?",
                        Spec_View => "?",
                        Load_View => "?",
                        Mode => Activity.Exact_Copy,
                        Target => "!machine.release.current.activity",
                        Response => "<PROFILE>");  
        Log.Put_Line ("Successfully merged activities");
    exception
        when others =>
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Merge_Activities",
                          Kind => Profile.Error_Msg);
            raise;
    end Merge_Activities;


    procedure Replace_Links is
        Key : constant String := Get_Target_Key;
    begin
        Log.Put_Line ("Replacing link to " & Key);
        Links.Replace (Source => "!targets.implementation.Rcf_customization." &
                                    Key & "'spec_view.units." & Key,
                       Link => "#",
                       World => "!machine.release.current.commands",
                       Response => "<PROFILE>");
        Log.Put_Line ("Successfully replaced link");
    exception
        when others =>
            Log.Put_Line (Message => "Unable to define link to " & Key,
                          Kind => Profile.Warning_Msg);
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Replace_Links");
    end Replace_Links;

    procedure Register_Target is  
        Key : constant String := Get_Target_Key;
    begin
        Log.Put_Line ("Registering target " & Key);
        Program.Run_Job (Key & ".register");
        Log.Put_Line ("Successfully registered target " & Key);
    exception
        when others =>
            Log.Put_Line (Debug_Tools.Get_Exception_Name &
                          " raised in Register_Target");
            raise;
    end Register_Target;

begin
    Restore_Predefined;
    Merge_Activities;
    Replace_Links;
    --Register_Target;
exception
    when Bad_Current_Context =>
        Log.Put_Line ("Unable to install " & Target_Key &
                      " due to unhandled exception " &
                      Debug_Tools.Get_Exception_Name, Profile.Negative_Msg);
    when others =>
        Log.Put_Line ("Unable to install " & Get_Target_Key &
                      " due to unhandled exception " &
                      Debug_Tools.Get_Exception_Name, Profile.Negative_Msg);
end Install_Customization;

    nblk1=9
    nid=0
    hdr6=12
        [0x00] rec0=1d rec1=00 rec2=01 rec3=068
        [0x01] rec0=1a rec1=00 rec2=02 rec3=078
        [0x02] rec0=1a rec1=00 rec2=03 rec3=088
        [0x03] rec0=12 rec1=00 rec2=04 rec3=08e
        [0x04] rec0=1a rec1=00 rec2=05 rec3=016
        [0x05] rec0=1a rec1=00 rec2=06 rec3=04e
        [0x06] rec0=19 rec1=00 rec2=07 rec3=00e
        [0x07] rec0=18 rec1=00 rec2=08 rec3=066
        [0x08] rec0=19 rec1=00 rec2=09 rec3=000
    tail 0x2170fc40e8313452b5632 0x42a00088462060003