|
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: 47104 (0xb800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Library_Extensions, seg_02121b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Download_Times;
with Extensions_Support;
with Library;
with Library_Interface;
with Log;
with Profile;
with Remote_Command_Interface;
with Remote_Links;
with String_Utilities;
with Utilities;
package body Library_Extensions is
package Du renames Utilities.Directory_Utilities;
package Es renames Extensions_Support;
package Li renames Library_Interface;
package Naming renames Directory.Naming;
package Rci renames Remote_Command_Interface;
package Rsu renames Utilities.Rci_Switch_Utilities;
package Ss renames Simple_Status;
package Su renames String_Utilities;
Debugging : Boolean := False;
Target_Key : constant String := "I386_Unix_Als_Xt";
function "=" (L, R : Directory.Error_Status) return Boolean
renames Directory."=";
function "=" (L, R : Naming.Name_Status) return Boolean renames Naming."=";
function Problem (Status : Ss.Condition;
Trace_On : Boolean) return Boolean is
begin
if Ss.Error (Status => Status,
Level => Ss.Problem) then
if Debugging or else Trace_On then
Log.Put_Line (Message => "~#" & Ss.Message (Status),
Kind => Profile.Negative_Msg);
end if;
return True;
end if;
return False;
end Problem;
function Qt (Str : String) return String is
begin
return " => """ & Str & """";
end Qt;
procedure Check (View_Object : Directory.Object;
Caller : String;
Remote_Machine : String;
Remote_Directory : String;
Host_Only : out Boolean;
Status : in out Ss.Condition) is
begin
Host_Only := False;
if Rsu.Is_Host_Only (View_Object) then
Log.Put_Line (Message => "Not executing " & Caller & ". " &
Naming.Get_Full_Name (View_Object) &
" is a Host_Only view",
Kind => Profile.Note_Msg);
Host_Only := True;
Ss.Initialize (Status);
elsif Remote_Machine = "" then
Log.Put_Line (Message =>
"Remote_Machine name for view " &
Naming.Get_Full_Name (View_Object) & " is null",
--[Kind => Profile.Warning_Msg);]
Kind => Profile.Negative_Msg);
Es.Set_Status (Message => "Insufficient remote machine information",
Status => Status,
--[Severity => Ss.Warning);]
Severity => Ss.Fatal);
elsif Remote_Directory = "" then
Log.Put_Line (Message =>
"Remote_Directory name for view " &
Naming.Get_Full_Name (View_Object) & " is null",
--[Kind => Profile.Warning_Msg);]
Kind => Profile.Negative_Msg);
Es.Set_Status (Message =>
"Insufficient remote directory information",
Status => Status,
--[Severity => Ss.Warning);]
Severity => Ss.Fatal);
end if;
end Check;
procedure Delete_Links_Files (View_Obj : Directory.Object) is
begin
-- Delete the view's Remote_Links file.
Library.Delete (Existing => Remote_Links.File_Name (View_Obj),
Limit => "<DIRECTORIES>",
Response => "<QUIET>");
-- Delete the view's Download_Times file.
Library.Delete (Existing =>
Download_Times.Download_Times_File_Name (View_Obj),
Limit => "<DIRECTORIES>",
Response => "<QUIET>");
end Delete_Links_Files;
procedure Set_Context (Old_Context : in out Naming.Context;
View : String;
Status : in out Ss.Condition) is
Error_Status : Directory.Error_Status;
New_Context : Naming.Context;
Dir_Object : Directory.Object;
Name_Status : Naming.Name_Status;
begin
Naming.Resolve (Name => View,
The_Object => Dir_Object,
Status => Name_Status);
if Name_Status /= Naming.Successful then
Es.Set_Status (Status => Status,
Message => "Can't resolve " & View &
". Name Status = " & Naming.Name_Status'Image
(Name_Status));
return;
end if;
-- Get the current naming context for Promote_Unit.
Naming.Get_Context (The_Context => New_Context,
The_Unit => Dir_Object,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Es.Set_Status (Status => Status,
Message => "Can't get default context for " &
View & ". Error Status = " &
Directory.Error_Status'Image
(Error_Status));
return;
end if;
-- Get the job's default naming context.
Old_Context := Naming.Default_Context;
-- We must restore this context (after any errors) before we return.
-- Change the job's default context to the unit's current context.
Naming.Set_Default_Context (The_Context => New_Context,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Es.Set_Status (Status => Status,
Message => "Can't set default context to " &
View & ". Error Status = " &
Directory.Error_Status'Image
(Error_Status));
return;
end if;
end Set_Context;
procedure Reset_Context (Old_Context : Directory.Naming.Context) is
Error_Status : Directory.Error_Status;
begin
-- Restore the job's original naming context.
Naming.Set_Default_Context (The_Context => Old_Context,
Status => Error_Status);
if Error_Status /= Directory.Successful then
Log.Put_Line ("Can't restore default context. Error Status = " &
Directory.Error_Status'Image (Error_Status),
Profile.Negative_Msg);
end if;
end Reset_Context;
procedure Make_Path_Preprocess (Host_Path_Name : String;
For_Release : Boolean;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
Stripped_Machine : constant String :=
Su.Strip (From => Remote_Machine, Filler => ' ');
Stripped_Directory : constant String :=
Su.Strip (From => Remote_Directory, Filler => ' ');
begin
Log.Put_Line (Message =>
"Make_Path_Preprocess (Host_Path_Name" &
Qt (Host_Path_Name) & ", For_Release => " &
Boolean'Image (For_Release) & ", Remote_Machine" &
Qt (Remote_Machine) & ", Remote_Directory" &
Qt (Remote_Directory) & ", Remote_Program_Library" &
Qt (Remote_Program_Library) & ")",
Kind => Profile.Sharp_Msg);
if Stripped_Machine'Length = 0 then
Log.Put_Line (Message => "Remote_Machine name for view " &
Qt (Host_Path_Name) & " is null",
Kind => Profile.Warning_Msg);
Es.Set_Status (Message => "Insufficient remote machine information",
Status => Status,
Severity => Ss.Warning);
elsif Stripped_Directory'Length = 0 then
Log.Put_Line (Message => "Remote_Directory name for view " &
Qt (Host_Path_Name) & " is null",
Kind => Profile.Warning_Msg);
Es.Set_Status (Message =>
"Insufficient remote directory information",
Status => Status,
Severity => Ss.Warning);
end if;
Log.Put_Line (Message => "Executing Make_Path_Preprocess",
Kind => Profile.Note_Msg);
-- Check whether we can obtain a valid family name from
-- Remote_Directory. The view hasn't been created yet, so we can't
-- look at its switches.
Es.Check_Family (View_Obj => Directory.Nil,
Remote_Machine => Remote_Machine,
Remote_Directory => Remote_Directory,
Status => Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Make_Path_Preprocess");
end Make_Path_Preprocess;
procedure Make_Path_Postprocess (Host_Path_Name : String;
For_Release : Boolean;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
View_Obj : Directory.Object :=
Du.Get_View (Host_Path_Name, Profile.Get);
View_Name : constant String := Naming.Get_Full_Name (View_Obj);
Stripped_Machine : constant String :=
Su.Strip (From => Remote_Machine, Filler => ' ');
Stripped_Directory : constant String :=
Su.Strip (From => Remote_Directory, Filler => ' ');
Old_Context : Directory.Naming.Context;
Host_Only : Boolean;
Trace_On : Boolean := Rsu.Trace_On (View_Obj);
begin
Log.Put_Line (Message =>
"Make_Path_Postprocess (Host_Path_Name" &
Qt (Host_Path_Name) & ", For_Release => " &
Boolean'Image (For_Release) & ", Remote_Machine" &
Qt (Remote_Machine) & ", Remote_Directory" &
Qt (Remote_Directory) & ", Remote_Program_Library" &
Qt (Remote_Program_Library) & ")",
Kind => Profile.Sharp_Msg);
if Directory.Is_Nil (View_Obj) then
return;
end if;
-- Delete any Remote_Links and Download_Times files that were copied
-- during Cmvc.Make_Path.
Delete_Links_Files (View_Obj);
Check (View_Obj, "Make_Path_Postprocess", Stripped_Machine,
Stripped_Directory, Host_Only, Status);
if Host_Only or else Ss.Error (Status, Ss.Warning) then
return;
end if;
Log.Put_Line (Message => "Executing Make_Path_Postprocess",
Kind => Profile.Note_Msg);
Set_Context (Old_Context => Old_Context,
View => View_Name,
Status => Status);
if Problem (Status, Trace_On) then
Es.Set_Status (Status => Status,
Message => "Make_Path_Postprocess Failed");
return;
end if;
-- Check whether we can obtain a valid family name.
Es.Check_Family (View_Obj => View_Obj,
Remote_Machine => Remote_Machine,
Remote_Directory => Remote_Directory,
Status => Status);
if Ss.Error (Status, Ss.Warning) then
-- No sense continuing if the family name is bad.
Reset_Context (Old_Context);
return;
end if;
-- Any exceptions within Build_Libraries will be absorbed there.
Es.Build_Libraries (View_Obj => View_Obj,
Remote_Machine => Stripped_Machine,
Remote_Directory => Stripped_Directory,
Remote_Program_Library => Remote_Program_Library,
Status => Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context);
exception
when others =>
Es.Unhandled_Exception (Status, "Make_Path_PostProcess");
end Make_Path_Postprocess;
procedure Destroy_View_Preprocess
(Host_Path_Name : String;
Status : in out Simple_Status.Condition) is
View_Obj : Directory.Object :=
Du.Get_View (Host_Path_Name, Profile.Get);
View_Name : constant String := Naming.Get_Full_Name (View_Obj);
Machine_Result : constant Li.String_Result :=
Li.Remote_Machine (View => View_Name);
Remote_Machine : constant String := Machine_Result.Result;
Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => View_Name);
View_Directory : constant String := Directory_Result.Result;
Remote_Connection : Rci.Context;
Old_Context : Naming.Context;
Local_Status : Ss.Condition;
Host_Only : Boolean;
Trace_On : Boolean := Rsu.Trace_On (View_Obj);
begin
Log.Put_Line (Message => "Destroy_View_Preprocess (Host_Path_Name" &
Qt (Host_Path_Name) & ")",
Kind => Profile.Sharp_Msg);
if Directory.Is_Nil (View_Obj) then
return;
end if;
if Problem (Machine_Result.Condition, Trace_On) then
Es.Set_Status
("Can't get remote machine name for view " & View_Name, Status);
return;
elsif Problem (Directory_Result.Condition, Trace_On) then
Es.Set_Status
("Can't get remote directory name for view " & View_Name,
Status);
return;
end if;
Check (View_Obj, "Destroy_View_Preprocess",
Remote_Machine, View_Directory, Host_Only, Status);
if Host_Only or else Ss.Error (Status, Ss.Warning) then
return;
end if;
Log.Put_Line (Message => "Executing Destroy_View_Preprocess",
Kind => Profile.Note_Msg);
Set_Context (Old_Context => Old_Context,
View => View_Name,
Status => Status);
if Problem (Status, Trace_On) then
Es.Set_Status ("Destroy_View_Preprocess failed", Status);
return;
end if;
-- Acquire a remote connection to the target.
Rci.Acquire (Remote_Connection => Remote_Connection,
Status => Status,
Target_Key => Target_Key,
-- Set_Directory => "cd " & View_Directory,
Remote_Machine => Remote_Machine,
Trace_Command => Trace_On);
if Problem (Status, Trace_On) then
Es.Set_Status (Status => Status,
Message => "Can't acquire connection to " &
Remote_Machine);
Reset_Context (Old_Context);
return;
end if;
-- Any exceptions within Destroy_Library will be absorbed there.
Es.Destroy_Library (Host_View => View_Obj,
Remote_Directory => View_Directory,
Remote_Connection => Remote_Connection,
Status => Status,
Trace_Command => Trace_On);
if Problem (Status, Trace_On) then
Es.Set_Status
(Status => Status,
Message => "Can't destroy the remote library for " & View_Name);
else
if Debugging or else Trace_On then
Log.Put_Line (Message =>
"~#Setting the Rci.Remote_Directory switch " &
"for view " & View_Name & " to null",
Kind => Profile.Note_Msg);
end if;
-- ***** This should really be in Destroy_View_Postprocess, but
-- ***** the RCI doesn't call that extension.
-- Delete the remote directory name from the switch file.
Li.Set_Remote_Directory (View => View_Name,
Value => "",
Condition => Status);
end if;
-- Delete the view's Remote_Links and Download_Times files.
Delete_Links_Files (View_Obj);
Reset_Context (Old_Context);
exception
when others =>
Es.Unhandled_Exception (Status, "Destroy_View_Preprocess");
begin
Reset_Context (Old_Context);
exception
when others =>
null;
end;
end Destroy_View_Preprocess;
procedure Destroy_View_Postprocess
(Host_Path_Name : String;
Remote_Machine : String; -- new
Remote_Directory : String; -- new
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line (Message => "Destroy_View_Postprocess (Host_Path_Name" &
Qt (Host_Path_Name) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Destroy_View_Postprocess",
Kind => Profile.Note_Msg);
exception
when others =>
Es.Unhandled_Exception (Status, "Destroy_View_Postprocess");
end Destroy_View_Postprocess;
procedure Import_Preprocess (Views_To_Import : Directory.Naming.Iterator;
Into_View : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line (Message =>
"Import_Preprocess (Into_View" & Qt (Into_View) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Import_Preprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Import_Preprocess");
end Import_Preprocess;
procedure Import_Postprocess (Views_To_Import : Directory.Naming.Iterator;
Into_View : String;
Status : in out Simple_Status.Condition) is
View_Obj : Directory.Object := Du.Get_View (Into_View, Profile.Get);
View_Name : constant String := Naming.Get_Full_Name (View_Obj);
Imported_Views : Naming.Iterator := Views_To_Import;
Machine_Result : constant Li.String_Result :=
Li.Remote_Machine (View => View_Name);
Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => View_Name);
Remote_Machine : constant String := Machine_Result.Result;
Remote_Directory : constant String := Directory_Result.Result;
Old_Context : Directory.Naming.Context;
Host_Only : Boolean;
Count : Natural := 0;
E_Status : Directory.Error_Status;
Import_Obj : Directory.Object;
Trace_On : Boolean := Rsu.Trace_On (View_Obj);
begin
if Directory.Is_Nil (View_Obj) or else
Naming.Done (Views_To_Import) then
Log.Put_Line (Message =>
"Import_Postprocess (First_Imported_View" &
" => null, Into_View" & Qt (Into_View) & ")",
Kind => Profile.Sharp_Msg);
return;
else
Log.Put_Line (Message =>
"Import_Postprocess (First_Imported_View" &
Qt (Naming.Source_Name (Imported_Views)) &
", Into_View" & Qt (Into_View) & ")",
Kind => Profile.Sharp_Msg);
end if;
if Problem (Machine_Result.Condition, Trace_On) then
Es.Set_Status
("Can't get remote machine name for view " & View_Name, Status);
return;
elsif Problem (Directory_Result.Condition, Trace_On) then
Es.Set_Status
("Can't get remote directory name for view " & View_Name,
Status);
return;
end if;
Check (View_Obj, "Import_Postprocess", Remote_Machine,
Remote_Directory, Host_Only, Status);
if Host_Only or else Ss.Error (Status, Ss.Warning) then
return;
end if;
Naming.Get_Object (Imported_Views, Import_Obj, E_Status);
if E_Status /= Directory.Successful then
Log.Put_Line ("Can't get first imported view. Error Status = " &
Directory.Error_Status'Image (E_Status),
Profile.Warning_Msg);
Log.Put_Line ("Executing Import_Postprocess", Profile.Note_Msg);
else
Log.Put_Line ("Executing Import_Postprocess. First imported view" &
Qt (Naming.Get_Full_Name (Import_Obj)),
Profile.Note_Msg);
end if;
Set_Context (Old_Context => Old_Context,
View => View_Name,
Status => Status);
if Problem (Status, Trace_On) then
Es.Set_Status ("Import_Postprocess failed", Status);
return;
end if;
if Debugging or else Trace_On then
-- Display all of the imported views.
while not Naming.Done (Imported_Views) loop
Count := Count + 1;
Naming.Get_Object (Imported_Views, Import_Obj, E_Status);
if E_Status /= Directory.Successful then
Log.Put_Line ("Can't get imported view" &
Integer'Image (Count) &
" from iterator. Error Status = " &
Directory.Error_Status'Image (E_Status),
Profile.Warning_Msg);
exit;
end if;
Log.Put_Line ("~#Imported_view" & Integer'Image (Count) &
Qt (Naming.Get_Full_Name (Import_Obj)),
Profile.Note_Msg);
Naming.Next (Imported_Views);
end loop;
Naming.Reset (Imported_Views);
end if;
-- Any exceptions within Perform_Remote_Import will be absorbed there.
Es.Perform_Remote_Import (Host_View => View_Name,
Views_To_Import => Views_To_Import,
Remote_Machine => Remote_Machine,
Status => Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context);
exception
when others =>
Es.Unhandled_Exception (Status, "Import_Postprocess");
end Import_Postprocess;
procedure Remove_Import_Preprocess
(View_To_Remove : Directory.Object;
From_View : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line
(Message => "Remove_Import_Preprocess (View_To_Remove => " &
Naming.Get_Full_Name (View_To_Remove) &
", From_View" & Qt (From_View) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Remove_Import_Preprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Remove_Import_Preprocess");
end Remove_Import_Preprocess;
procedure Remove_Import_Postprocess
(View_To_Remove : Directory.Object;
From_View : String;
Status : in out Simple_Status.Condition) is
View_Obj : Directory.Object := Du.Get_View (From_View, Profile.Get);
View_Name : constant String := Naming.Get_Full_Name (View_Obj);
Remote_Machine_Result : constant Li.String_Result :=
Li.Remote_Machine (View => View_Name);
Remote_Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View => View_Name);
Remote_Machine : constant String := Remote_Machine_Result.Result;
Remote_Directory : constant String := Remote_Directory_Result.Result;
Old_Context : Naming.Context;
Host_Only : Boolean;
Remote_Connection : Rci.Context;
Trace_On : Boolean := Rsu.Trace_On (View_Obj);
begin
Log.Put_Line
(Message => "Remove_Import_Postprocess (View_To_Remove => " &
Naming.Get_Full_Name (View_To_Remove) &
", From_View" & Qt (From_View) & ")",
Kind => Profile.Sharp_Msg);
if Problem (Remote_Machine_Result.Condition, Trace_On) then
Es.Set_Status
("Can't get remote machine name for view " & View_Name, Status);
return;
elsif Problem (Remote_Directory_Result.Condition, Trace_On) then
Es.Set_Status
("Can't get remote directory name for view " & View_Name,
Status);
return;
end if;
Check (View_Obj, "Remove_Import_Postprocess",
Remote_Machine, Remote_Directory, Host_Only, Status);
if Host_Only or else Ss.Error (Status, Ss.Warning) then
return;
end if;
Log.Put_Line (Message => "Executing Remove_Import_Postprocess",
Kind => Profile.Note_Msg);
Set_Context (Old_Context => Old_Context,
View => View_Name,
Status => Status);
if Problem (Status, Trace_On) then
Es.Set_Status ("Remove_Import_Postprocess failed", Status);
return;
end if;
-- Remove View_To_Remove as a remote import of From_View on the
-- Remote_Machine. Note that Remote_Connection is undefined, but it
-- won't be used, no matter what it is.
Es.Remove_Remote_Import (View_To_Remove => View_To_Remove,
From_View => From_View,
Remote_Machine => Remote_Machine,
Remote_Directory => Remote_Directory,
Remote_Connection => Remote_Connection,
Destroying_Library => False,
Status => Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context);
exception
when others =>
Es.Unhandled_Exception (Status, "Remove_Import_Postprocess");
end Remove_Import_Postprocess;
procedure Release_Preprocess (From_Working_View : String;
Released_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line
(Message => "Release_Preprocess (From_Working_View" &
Qt (From_Working_View) & ", Released_View" &
Qt (Released_View) & ", Remote_Machine" &
Qt (Remote_Machine) & ", Remote_Directory" &
Qt (Remote_Directory) & ", Remote_Program_Library" &
Qt (Remote_Program_Library) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Release_Preprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Release_Preprocess");
end Release_Preprocess;
procedure Release_Postprocess (View_To_Remove : String;
Released_View : String;
Remote_Machine : String;
Remote_Directory : String;
Remote_Program_Library : String;
Status : in out Simple_Status.Condition) is
begin
Log.Put_Line
(Message => "Release_Postprocess (View_To_Remove" &
Qt (View_To_Remove) & ", Released_View" &
Qt (Released_View) & ", Remote_Machine" &
Qt (Remote_Machine) & ", Remote_Directory" &
Qt (Remote_Directory) & ", Remote_Program_Library" &
Qt (Remote_Program_Library) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Release_Postprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
exception
when others =>
Es.Unhandled_Exception (Status, "Release_Postprocess");
end Release_Postprocess;
procedure Link_Preprocess (Main_Unit : String;
Executable_Name : String;
Status : in out Simple_Status.Condition) is
Simple_Name : constant String := Naming.Get_Simple_Name (Main_Unit);
begin
Log.Put_Line
(Message => "Link_Preprocess (Main_Unit" & Qt (Main_Unit) & ", Executable_Name" & Qt (Executable_Name) & ")",
Kind => Profile.Sharp_Msg);
Log.Put_Line (Message => "Executing Link_Preprocess",
Kind => Profile.Note_Msg);
Ss.Initialize (Status);
if Executable_Name'Length > 14 then
Log.Put_Line
(Message => "The Alsys linker won't allow " &
"the executable name """ & Executable_Name &
""", which exceeds 14 characters, " &
"so this attempt to Link """ &
Main_Unit & """ will probably fail. " &
"Verify that the 'bind' operation " &
"has failed on the remote machine, and then " &
"re-run Rci.Link with a shorter Executable_Name",
Kind => Profile.Warning_Msg);
elsif Executable_Name'Length = 0 and then Simple_Name'Length > 10 then
Log.Put_Line (Message =>
"The Alsys linker will truncate the unit name """ &
Simple_Name & """ to 10 characters (""" &
Simple_Name (Simple_Name'First ..
Simple_Name'First + 9) &
""") for naming its remote files. " &
"The RCI will then rename the generated " &
"files to the unit name",
Kind => Profile.Warning_Msg);
end if;
exception
when others =>
Es.Unhandled_Exception (Status, "Link_Preprocess");
end Link_Preprocess;
procedure Link_Postprocess (Main_Unit : String;
Executable_Name : String;
Status : in out Simple_Status.Condition) is
View_Obj : Directory.Object := Du.Get_View (Main_Unit, Profile.Get);
View_Name : constant String := Naming.Get_Full_Name (View_Obj);
Remote_Directory_Result : constant Li.String_Result :=
Li.Remote_Directory (View_Name);
Remote_Machine_Result : constant Li.String_Result :=
Li.Remote_Machine (View_Name);
Remote_Directory : constant String := Remote_Directory_Result.Result;
Remote_Machine : constant String := Remote_Machine_Result.Result;
Old_Context : Naming.Context;
Host_Only : Boolean;
Trace_On : Boolean := Rsu.Trace_On (View_Obj);
begin
Log.Put_Line
(Message => "Link_Postprocess (Main_Unit" & Qt (Main_Unit) &
", Executable_Name" & Qt (Executable_Name) & ")",
Kind => Profile.Sharp_Msg);
if Directory.Is_Nil (View_Obj) then
return;
end if;
if Problem (Remote_Machine_Result.Condition, Trace_On) then
Es.Set_Status
("Can't get remote machine name for view " & View_Name, Status);
return;
elsif Problem (Remote_Directory_Result.Condition, Trace_On) then
Es.Set_Status
("Can't get remote directory name for view " & View_Name,
Status);
return;
end if;
Check (View_Obj, "Link_Postprocess", Remote_Machine,
Remote_Directory, Host_Only, Status);
if Host_Only or else Ss.Error (Status, Ss.Warning) then
return;
end if;
Log.Put_Line (Message => "Executing Link_Postprocess",
Kind => Profile.Note_Msg);
Set_Context (Old_Context => Old_Context,
View => View_Name,
Status => Status);
if Problem (Status, Trace_On) then
Es.Set_Status (Status => Status,
Message => "Link_Postprocess Failed");
return;
end if;
-- Any exceptions within Retrieve_Files will be absorbed there.
Es.Retrieve_Files (Main_Unit => Main_Unit,
Executable_Name => Executable_Name,
Enclosing_View_Name => View_Name,
Remote_Machine => Remote_Machine,
Remote_Directory => Remote_Directory,
Status => Status,
Trace_Command => Trace_On);
Reset_Context (Old_Context);
exception
when others =>
Es.Unhandled_Exception (Status, "Link_Postprocess");
end Link_Postprocess;
end Library_Extensions;
nblk1=2d
nid=0
hdr6=5a
[0x00] rec0=22 rec1=00 rec2=01 rec3=004
[0x01] rec0=00 rec1=00 rec2=2d rec3=034
[0x02] rec0=20 rec1=00 rec2=02 rec3=04c
[0x03] rec0=16 rec1=00 rec2=03 rec3=008
[0x04] rec0=16 rec1=00 rec2=04 rec3=02a
[0x05] rec0=19 rec1=00 rec2=05 rec3=002
[0x06] rec0=00 rec1=00 rec2=2c rec3=008
[0x07] rec0=15 rec1=00 rec2=06 rec3=098
[0x08] rec0=19 rec1=00 rec2=07 rec3=014
[0x09] rec0=16 rec1=00 rec2=08 rec3=042
[0x0a] rec0=00 rec1=00 rec2=2b rec3=004
[0x0b] rec0=11 rec1=00 rec2=09 rec3=06c
[0x0c] rec0=16 rec1=00 rec2=0a rec3=02c
[0x0d] rec0=17 rec1=00 rec2=0b rec3=02e
[0x0e] rec0=00 rec1=00 rec2=29 rec3=00c
[0x0f] rec0=17 rec1=00 rec2=0c rec3=070
[0x10] rec0=1a rec1=00 rec2=0d rec3=022
[0x11] rec0=19 rec1=00 rec2=0e rec3=032
[0x12] rec0=1b rec1=00 rec2=2a rec3=064
[0x13] rec0=01 rec1=00 rec2=0f rec3=01e
[0x14] rec0=1d rec1=00 rec2=10 rec3=026
[0x15] rec0=19 rec1=00 rec2=11 rec3=070
[0x16] rec0=15 rec1=00 rec2=12 rec3=06e
[0x17] rec0=1f rec1=00 rec2=13 rec3=058
[0x18] rec0=1c rec1=00 rec2=14 rec3=05a
[0x19] rec0=1a rec1=00 rec2=15 rec3=026
[0x1a] rec0=00 rec1=00 rec2=28 rec3=01a
[0x1b] rec0=17 rec1=00 rec2=16 rec3=082
[0x1c] rec0=1c rec1=00 rec2=17 rec3=09c
[0x1d] rec0=19 rec1=00 rec2=18 rec3=050
[0x1e] rec0=1a rec1=00 rec2=19 rec3=022
[0x1f] rec0=1b rec1=00 rec2=1a rec3=054
[0x20] rec0=19 rec1=00 rec2=1b rec3=024
[0x21] rec0=00 rec1=00 rec2=27 rec3=010
[0x22] rec0=1c rec1=00 rec2=1c rec3=040
[0x23] rec0=13 rec1=00 rec2=1d rec3=050
[0x24] rec0=16 rec1=00 rec2=1e rec3=086
[0x25] rec0=19 rec1=00 rec2=1f rec3=01a
[0x26] rec0=1a rec1=00 rec2=20 rec3=002
[0x27] rec0=14 rec1=00 rec2=21 rec3=03a
[0x28] rec0=14 rec1=00 rec2=22 rec3=096
[0x29] rec0=1c rec1=00 rec2=23 rec3=014
[0x2a] rec0=00 rec1=00 rec2=26 rec3=010
[0x2b] rec0=1d rec1=00 rec2=24 rec3=03a
[0x2c] rec0=16 rec1=00 rec2=25 rec3=000
tail 0x2151cb132838d6b97cf31 0x42a00088462065003