|
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: 24576 (0x6000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Asa, seg_01075f
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Action;
with Asa_Definitions;
with Calendar;
with Debug_Tools;
with Directory;
with Gateways;
with Gateway_Object;
with Hierarchy;
with Logger;
with Object_Class;
with Object_Subclass;
with Profile;
with Simple_Status;
with Unix_Definitions;
package body Asa is
Package_Name : constant String := "Asa.";
package Asap renames Asa_Definitions.Properties;
package Dir renames Directory;
package Dcp renames Directory.Control_Point;
package Dna renames Directory.Naming;
package Gwo renames Gateway_Object;
package Hchy renames Hierarchy;
package Ss renames Simple_Status;
package Unix renames Unix_Definitions;
function Must_Raise_Error return Boolean is
use Profile;
begin
return Profile.Reaction = Profile.Propagate or else
Profile.Reaction = Profile.Raise_Error;
end Must_Raise_Error;
procedure Check_Requirement_Name (Requirement_Name : in String;
Action_Id : in Action.Id;
Is_A_Requirement : out Boolean;
Requirement_Object : out Dir.Object;
Requirement_Handle : out Gwo.Handle) is
E : Dir.Error_Status;
Handle : Gwo.Handle;
N : Dna.Name_Status;
Object : Dir.Object;
S : Ss.Condition;
use Asa_Definitions;
use Dna;
begin
Dna.Resolve (Name => Requirement_Name,
The_Object => Object,
Status => N);
if N /= Dna.Successful then
Is_A_Requirement := False;
Requirement_Object := Dir.Nil;
Requirement_Handle := Gwo.Null_Handle;
elsif Dir.Is_Gateway (Object) then
Gwo.Open_Main_Object (Object => Object,
H => Handle,
Update => False,
Action_Id => Action_Id,
Errors => S);
if Ss.Error (S) or else Asap.Class (Handle) /=
Asa_Definitions.Asa_Requirement then
Is_A_Requirement := False;
Requirement_Object := Object;
Requirement_Handle := Gwo.Null_Handle;
else
Is_A_Requirement := True;
Requirement_Object := Object;
Requirement_Handle := Handle;
end if;
end if;
end Check_Requirement_Name;
procedure Check_View_Name (View_Name : in String;
Action_Id : in Action.Id;
Is_A_Combined_View : out Boolean;
View_Object : out Dir.Object) is
E : Dir.Error_Status;
N : Dna.Name_Status;
Object : Dir.Object;
View : Dir.Object; View_Subclass : Dir.Subclass;
use Dir;
use Dna;
begin
Dna.Resolve (Name => View_Name,
The_Object => Object,
Status => N,
Action_Id => Action_Id);
if N /= Dna.Successful then
Is_A_Combined_View := False;
View_Object := Dir.Nil;
else
if Dcp.Is_World (Object) then
View := Object;
else
Dcp.Parent_World
(The_Object => Object, The_World => View, Status => E);
if E /= Successful then
Is_A_Combined_View := False;
View_Object := Dir.Nil;
end if;
end if;
View_Subclass := Dir.Get_Subclass (View);
Is_A_Combined_View := View_Subclass =
Object_Subclass.Combined_View_Subclass;
View_Object := View;
end if;
end Check_View_Name;
function Root_Of (Gateway : in Dir.Object; Action_Id : in Action.Id)
return Dir.Object is
E : Dir.Error_Status;
Gateway_Data : Dir.Statistics.Object_Data;
Result : Dir.Object;
use Dir;
begin
Result := Gateway;
loop
Dir.Statistics.Get_Object_Data (The_Object => Result,
The_Data => Gateway_Data,
Status => E,
Action_Id => Action_Id);
exit when Dir.Get_Class
(Dir.Statistics.Object_Parent (Gateway_Data)) =
Object_Class.Library;
Result := Dir.Statistics.Object_Parent (Gateway_Data);
end loop;
return Result;
end Root_Of;
procedure Create_Requirement (For_Object : in String := "<CURSOR>";
Name : in String := ">>Requirement Name<<";
Kind : in Requirements.Non_Functional :=
Requirements.Performance;
Comments : in String := "";
Work_Order : in String := "<DEFAULT>";
Response : in String := "<PROFILE>") is
Subprogram_Name : constant String := "Create_Requirement";
S : Ss.Condition;
The_Action : Action.Id;
The_State : Gateways.State;
begin
Profile.Set (Response, S);
The_Action := Action.Start;
Gateways.Initialize (The_State => The_State,
Action_Id => The_Action,
Work_Order => Work_Order);
Gateways.Create (In_Gateway => For_Object,
Requirement_Name => Name,
Requirement_Kind => Kind,
Requirement_Text => "",
Comments => Comments,
The_State => The_State);
Gateways.Finalize (The_State);
Action.Finish (The_Action, Do_Commit => True);
exception
when Profile.Error =>
Logger.Error (Package_Name & Subprogram_Name &
" is quitting after errors",
Raise_Error => Must_Raise_Error);
when others =>
Logger.Error (Package_Name & Subprogram_Name &
" aborted by exception " &
Debug_Tools.Get_Exception_Name,
Raise_Error => Must_Raise_Error);
Action.Finish (The_Action, Do_Commit => False);
end Create_Requirement;
procedure Copy_Requirement (Requirement : in String := "<REGION>";
To_Object : in String := "<CURSOR>";
Comments : in String := "";
Work_Order : in String := "<DEFAULT>";
Response : in String := "<PROFILE>") is
Subprogram_Name : constant String := "Copy_Requirement";
Gateway : Gwo.Handle;
Gateway_Object : Dir.Object;
Is_A_Requirement : Boolean;
S : Ss.Condition;
The_Action : Action.Id := Action.Start;
The_State : Gateways.State;
begin
Profile.Set (Response, S);
Check_Requirement_Name (Requirement_Name => Requirement,
Action_Id => The_Action,
Is_A_Requirement => Is_A_Requirement,
Requirement_Object => Gateway_Object,
Requirement_Handle => Gateway);
if not Is_A_Requirement then
if Dir.Is_Nil (Gateway_Object) then
Logger.Negative (Requirement & " is not a gateway of class " &
Asa_Definitions.Gateway_Class'Image
(Asa_Definitions.Asa_Requirement));
else
Logger.Negative (Dna.Get_Full_Name (Gateway_Object) &
" is not a gateway of class " &
Asa_Definitions.Gateway_Class'Image
(Asa_Definitions.Asa_Requirement));
end if;
end if;
Gateways.Initialize (The_State => The_State,
Action_Id => The_Action,
Work_Order => Work_Order);
Gateways.Create (In_Gateway => To_Object,
Requirement_Name =>
Dna.Get_Simple_Name (Gateway_Object),
Requirement_Kind =>
Asap.Asa_Requirement_Kind (Gateway),
Requirement_Text =>
Asap.Asa_Requirement_Text (Gateway),
Comments => Comments,
The_State => The_State);
Gateways.Finalize (The_State);
Action.Finish (The_Action, Do_Commit => True);
exception
when Profile.Error =>
Logger.Error (Package_Name & Subprogram_Name &
" is quitting after errors",
Raise_Error => Must_Raise_Error);
when others =>
Logger.Error (Package_Name & Subprogram_Name &
" aborted by exception " &
Debug_Tools.Get_Exception_Name,
Raise_Error => Must_Raise_Error);
Action.Finish (The_Action, Do_Commit => False);
end Copy_Requirement;
procedure Move_Requirement (Requirement : in String := "<REGION>";
To_Object : in String := "<CURSOR>";
Comments : in String := "";
Work_Order : in String := "<DEFAULT>";
Response : in String := "<PROFILE>") is
Subprogram_Name : constant String := "Move_Requirement";
Gateway : Gwo.Handle;
Gateway_Object : Dir.Object;
Is_A_Requirement : Boolean;
S : Ss.Condition;
The_Action : Action.Id := Action.Start;
The_State : Gateways.State;
begin
Profile.Set (Response, S);
Check_Requirement_Name (Requirement_Name => Requirement,
Action_Id => The_Action,
Is_A_Requirement => Is_A_Requirement,
Requirement_Object => Gateway_Object,
Requirement_Handle => Gateway);
if not Is_A_Requirement then
if Dir.Is_Nil (Gateway_Object) then
Logger.Negative (Requirement & " is not a gateway of class " & Asa_Definitions.Gateway_Class'Image
(Asa_Definitions.Asa_Requirement));
else
Logger.Negative (Dna.Get_Full_Name (Gateway_Object) &
" is not a gateway of class " &
Asa_Definitions.Gateway_Class'Image
(Asa_Definitions.Asa_Requirement));
end if;
end if;
Gateways.Initialize (The_State => The_State,
Action_Id => The_Action,
Work_Order => Work_Order);
Gateways.Create (In_Gateway => To_Object,
Requirement_Name =>
Dna.Get_Simple_Name (Gateway_Object),
Requirement_Kind =>
Asap.Asa_Requirement_Kind (Gateway),
Requirement_Text =>
Asap.Asa_Requirement_Text (Gateway),
Comments => Comments,
The_State => The_State);
Gateways.Destroy (Gateway_Name => Dna.Get_Full_Name (Gateway_Object),
Comments => Comments,
The_State => The_State);
Gateways.Finalize (The_State);
Action.Finish (The_Action, Do_Commit => True);
exception
when Profile.Error =>
Logger.Error (Package_Name & Subprogram_Name &
" is quitting after errors",
Raise_Error => Must_Raise_Error);
when others =>
Logger.Error (Package_Name & Subprogram_Name &
" aborted by exception " &
Debug_Tools.Get_Exception_Name,
Raise_Error => Must_Raise_Error);
Action.Finish (The_Action, Do_Commit => False);
end Move_Requirement;
procedure Accept_Changes (In_Object : in String := "<CURSOR>";
Comments : in String := "";
Work_Order : in String := "<DEFAULT>";
Response : in String := "<PROFILE>") is
Subprogram_Name : constant String := "Accept_Changes";
Build_Time : Calendar.Time;
E : Dir.Error_Status;
Enclosing_Library : Dir.Object;
Gateway : Gwo.Handle;
Gateway_Object : Dir.Object;
Root_Iterator : Hchy.Module_Iterator;
Root_Module : Hchy.Module;
S : Ss.Condition;
The_Action : Action.Id := Action.Start;
The_State : Gateways.State;
begin
Profile.Set (Response, S);
--
-- Open the specified gateway.
--
Gwo.Open_Main_Object (Object => In_Object,
H => Gateway,
Update => False,
Action_Id => The_Action,
Errors => S);
Logger.Status (S);
Gateway_Object := Gwo.Directory_Object (Gateway);
Dcp.Parent_Library (The_Object => Gateway_Object,
The_Library => Enclosing_Library,
Status => E);
Logger.Status (E);
declare
Host : constant String := Asap.Data_Host (Gateway);
Model : constant String := Asap.Data_Context (Gateway) &
Unix.Context_Separator &
Asap.Data_Name (Gateway);
begin
--
-- Compute module hierarchy for the associated model.
--
Logger.Note ("Building module hierarchy for model " & Model);
Hchy.Build (Model => Model,
Host => Host,
Root => Root_Module,
Build_Time => Build_Time);
Root_Iterator := Hchy.Make (Root_Module);
Gwo.Close (Gateway, Errors => S);
Logger.Status (S);
--
-- Find the root of the gateway tree.
--
Gateway_Object := Root_Of (Gateway => Gateway_Object,
Action_Id => The_Action);
Gateways.Initialize (The_State => The_State,
Action_Id => The_Action,
Work_Order => Work_Order);
--
-- Delete those gateways that no longer have corresponding
-- modules.
--
Gateways.Reduce (Gateway_Name => Dna.Get_Full_Name (Gateway_Object),
Candidate_Modules => Root_Iterator,
Comments => Comments,
The_State => The_State);
--
-- Create gateways for the new modules.
--
Gateways.Augment
(For_Module => Root_Module,
In_Library => Dna.Get_Full_Name (Enclosing_Library),
Host => Host,
Model => Model,
Update_Time => Build_Time,
Comments => Comments,
The_State => The_State);
Gateways.Finalize (The_State);
Action.Finish (The_Action, Do_Commit => True);
end;
exception
when Profile.Error =>
Logger.Error (Package_Name & Subprogram_Name &
" is quitting after errors",
Raise_Error => Must_Raise_Error);
when others =>
Logger.Error (Package_Name & Subprogram_Name &
" aborted by exception " &
Debug_Tools.Get_Exception_Name,
Raise_Error => Must_Raise_Error);
Action.Finish (The_Action, Do_Commit => False);
end Accept_Changes;
procedure Create_Model (Model : in String := ">>ASA Model Name<<";
Host : in String := ">>Machine Name<<";
Into_View : in String := "<CURSOR>";
Comments : in String := "";
Work_Order : in String := "<DEFAULT>";
Response : in String := "<PROFILE>") is
Subprogram_Name : constant String := "Create_Model";
S : Ss.Condition;
Build_Time : Calendar.Time;
Is_A_Combined_View : Boolean;
Root_Module : Hchy.Module;
The_Action : Action.Id := Action.Start;
The_State : Gateways.State;
View : Dir.Object;
use Dir;
begin
Profile.Set (Response, S);
Check_View_Name (View_Name => Into_View,
Action_Id => The_Action,
Is_A_Combined_View => Is_A_Combined_View,
View_Object => View);
if not Is_A_Combined_View then
if Dir.Is_Nil (View) then
Logger.Negative (Into_View & " is not a combined view");
else
Logger.Negative (Dna.Get_Full_Name (View) &
" is not a combined view");
end if;
end if;
Root_Module := Hchy.Make (Identifier => Unix.Simple_Name (Model));
Gateways.Initialize (The_State => The_State,
Action_Id => The_Action,
Work_Order => Work_Order);
Gateways.Create (For_Module => Root_Module,
In_Library => Dna.Get_Full_Name (View) & ".Units",
Host => Host,
Model => Model,
Update_Time => Build_Time,
Comments => Comments,
The_State => The_State);
Gateways.Finalize (The_State);
Action.Finish (The_Action, Do_Commit => True);
exception
when Profile.Error =>
Logger.Error (Package_Name & Subprogram_Name &
" is quitting after errors",
Raise_Error => Must_Raise_Error);
when others =>
Logger.Error (Package_Name & Subprogram_Name &
" aborted by exception " &
Debug_Tools.Get_Exception_Name,
Raise_Error => Must_Raise_Error);
Action.Finish (The_Action, Do_Commit => False);
end Create_Model;
procedure Import_Model (Model : in String := ">>ASA Model Name<<";
Host : in String := ">>Machine Name<<";
Into_View : in String := "<CURSOR>";
Comments : in String := "";
Work_Order : in String := "<DEFAULT>";
Response : in String := "<PROFILE>") is
Subprogram_Name : constant String := "Import_Model";
S : Ss.Condition;
Build_Time : Calendar.Time;
Is_A_Combined_View : Boolean;
Root_Module : Hchy.Module;
The_Action : Action.Id := Action.Start;
The_State : Gateways.State;
View : Dir.Object;
use Dir;
begin
Profile.Set (Response, S);
Check_View_Name (View_Name => Into_View,
Action_Id => The_Action,
Is_A_Combined_View => Is_A_Combined_View,
View_Object => View);
if not Is_A_Combined_View then
if Dir.Is_Nil (View) then
Logger.Negative (Into_View & " is not a combined view");
else
Logger.Negative (Dna.Get_Full_Name (View) &
" is not a combined view");
end if;
end if;
Logger.Note ("Building module hierarchy for model " & Model);
Hchy.Build (Model => Model,
Host => Host,
Root => Root_Module,
Build_Time => Build_Time);
Gateways.Initialize (The_State => The_State,
Action_Id => The_Action,
Work_Order => Work_Order);
Gateways.Create (For_Module => Root_Module,
In_Library => Dna.Get_Full_Name (View) & ".Units",
Host => Host,
Model => Model,
Update_Time => Build_Time,
Comments => Comments,
The_State => The_State);
Gateways.Finalize (The_State);
Action.Finish (The_Action, Do_Commit => True);
exception
when Profile.Error =>
Logger.Error (Package_Name & Subprogram_Name &
" is quitting after errors",
Raise_Error => Must_Raise_Error);
when others =>
Logger.Error (Package_Name & Subprogram_Name &
" aborted by exception " &
Debug_Tools.Get_Exception_Name,
Raise_Error => Must_Raise_Error);
Action.Finish (The_Action, Do_Commit => False);
end Import_Model;
end Asa;
nblk1=17
nid=0
hdr6=2e
[0x00] rec0=24 rec1=00 rec2=01 rec3=086
[0x01] rec0=17 rec1=00 rec2=02 rec3=05a
[0x02] rec0=18 rec1=00 rec2=03 rec3=002
[0x03] rec0=1a rec1=00 rec2=04 rec3=03e
[0x04] rec0=1a rec1=00 rec2=05 rec3=020
[0x05] rec0=14 rec1=00 rec2=06 rec3=012
[0x06] rec0=14 rec1=00 rec2=07 rec3=05c
[0x07] rec0=15 rec1=00 rec2=08 rec3=004
[0x08] rec0=14 rec1=00 rec2=09 rec3=038
[0x09] rec0=16 rec1=00 rec2=0a rec3=05a
[0x0a] rec0=15 rec1=00 rec2=0b rec3=002
[0x0b] rec0=14 rec1=00 rec2=0c rec3=036
[0x0c] rec0=17 rec1=00 rec2=0d rec3=00a
[0x0d] rec0=18 rec1=00 rec2=0e rec3=038
[0x0e] rec0=18 rec1=00 rec2=0f rec3=030
[0x0f] rec0=1a rec1=00 rec2=10 rec3=032
[0x10] rec0=19 rec1=00 rec2=11 rec3=018
[0x11] rec0=17 rec1=00 rec2=12 rec3=03c
[0x12] rec0=17 rec1=00 rec2=13 rec3=01e
[0x13] rec0=14 rec1=00 rec2=14 rec3=044
[0x14] rec0=18 rec1=00 rec2=15 rec3=06a
[0x15] rec0=18 rec1=00 rec2=16 rec3=046
[0x16] rec0=0c rec1=00 rec2=17 rec3=000
tail 0x2170c8ac2823076ceedda 0x42a00088462060003