|
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: 10240 (0x2800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Install_Customization, seg_014291
└─⟦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