|
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: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Notice, seg_026552, seg_026ce5
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-------------------------------------------------------------------------------
with Umps_Defs;
with Wild_String;
with Slot;
with Set;
with Text_Io;
package body Notice is
Tabulation : constant String (1 .. 15) := (others => ' ');
---------------------------------------------------------------------------
procedure Add_Sender (Behavior : Umps_Defs.Behavior_Number;
Into : in out Element) is
begin
Into.Sender := Behavior;
end Add_Sender;
---------------------------------------------------------------------------
procedure Add_Handler (Behavior : Umps_Defs.Behavior_Number;
Into : in out Element) is
begin
Into.Handler := Behavior;
end Add_Handler;
---------------------------------------------------------------------------
procedure Add_Class (Class : String; Into : in out Element) is
begin
if (not Set.Is_Empty (Into.Params)) then
Set.Free (Into.Params);
end if;
Into.Class := Umps_Defs.Normalize (The_Name => Class);
end Add_Class;
---------------------------------------------------------------------------
procedure Add_Id (Id : String; Into : in out Element) is
begin
if (not Set.Is_Empty (Into.Params)) then
Set.Free (Into.Params);
end if;
Into.Id := Umps_Defs.Normalize (The_Name => Id);
end Add_Id;
---------------------------------------------------------------------------
procedure Add_Params (Params : Set.Object; Into : in out Element) is
function Is_Name_Less is new Slot.Is_Less (Field => Slot.On_Name);
procedure Sort_All is new Set.Sort ("<" => Is_Name_Less);
begin
Into.Params := Params;
Sort_All (Into.Params);
end Add_Params;
---------------------------------------------------------------------------
procedure Add_Param (Param : Slot.Element; Into : in out Element) is
function Is_Name_Less is new Slot.Is_Less (Field => Slot.On_Name);
procedure Sort_All is new Set.Sort ("<" => Is_Name_Less);
begin
Into.Params := Set.Add (Param, Into => Into.Params);
Sort_All (Into.Params);
end Add_Param;
---------------------------------------------------------------------------
function Sender (Of_The_Element : Element)
return Umps_Defs.Behavior_Number is
begin
return Of_The_Element.Sender;
end Sender;
---------------------------------------------------------------------------
function Handler (Of_The_Element : Element)
return Umps_Defs.Behavior_Number is
begin
return Of_The_Element.Handler;
end Handler;
---------------------------------------------------------------------------
function Params (Of_The_Element : Element) return Set.Object is
begin
return Of_The_Element.Params;
end Params;
---------------------------------------------------------------------------
function Param (Of_The_Element : Element; With_Name : String)
return Slot.Element is
The_Element : Slot.Element;
Iter : Set.Iterator;
begin
Set.Init (Iter, Of_The_Element.Params);
while (not Set.Done (Iter, Of_The_Element.Params)) loop
The_Element := Set.Value (Iter, Of_The_Element.Params);
if (Slot.Name_Of (The_Element) = With_Name) then
return The_Element;
end if;
Set.Next (Iter, Of_The_Element.Params);
end loop;
return Slot.Make ("", Slot.Void);
end Param;
---------------------------------------------------------------------------
function Class (Of_The_Element : Element) return String is
begin
return Umps_Defs.Denormalize (Of_The_Element.Class);
end Class;
---------------------------------------------------------------------------
function Id (Of_The_Element : Element) return String is
begin
return Umps_Defs.Denormalize (Of_The_Element.Id);
end Id;
---------------------------------------------------------------------------
function Image (The_Element : Element) return String is
function Image_Of is new Set.Image (Separator, Image => Slot.Image);
begin
return Umps_Defs.Behavior_Number'Image (Sender (The_Element)) &
Separator &
Umps_Defs.Behavior_Number'Image (Handler (The_Element)) &
Separator &
Class (The_Element) &
Separator &
Id (The_Element) &
Separator &
Image_Of (Params (The_Element));
end Image;
---------------------------------------------------------------------------
procedure Display (The_Element : Element; String_Before : String := "") is
procedure Display_All is new Set.Display (Display => Slot.Display);
begin
Text_Io.Put_Line (String_Before & "Class => " & Umps_Defs.Class_Notice);
Text_Io.Put_Line (String_Before & " Sender => " &
Umps_Defs.Behavior_Number'Image
(Sender (The_Element)));
Text_Io.Put_Line (String_Before & " Handler => " &
Umps_Defs.Behavior_Number'Image
(Handler (The_Element)));
Text_Io.Put_Line (String_Before & " Op Code => " &
Class (The_Element));
Text_Io.Put_Line (String_Before & " Id => " &
Id (The_Element));
Text_Io.Put_Line (String_Before & " Parameters => ");
Display_All (Params (The_Element), String_Before & Tabulation);
end Display;
---------------------------------------------------------------------------
function Is_Equal (Left, Right : Element) return Boolean is
The_Same : Boolean;
begin
The_Same := Sender (Left) = Sender (Right) and then
Handler (Left) = Handler (Right) and then
Wild_String.Is_Equal (Class (Left),
Class (Right)) and then
Wild_String.Is_Equal (Id (Left), Id (Right));
if not The_Same then
return False;
elsif (Slot."=" (Field, Slot.On_None)) then
return True;
else
Compare_Parameters:
declare
function Is_Field_Equal is
new Slot.Is_Equal (Field => Field);
function Is_Object_Equal is
new Set.Is_Equal (Is_Equal => Is_Field_Equal);
begin
return Is_Object_Equal (Params (Right), Params (Left));
end Compare_Parameters;
end if;
end Is_Equal;
end Notice;
-------------------------------------------------------------------------------
nblk1=b
nid=3
hdr6=12
[0x00] rec0=22 rec1=00 rec2=01 rec3=016
[0x01] rec0=1b rec1=00 rec2=06 rec3=074
[0x02] rec0=03 rec1=00 rec2=02 rec3=04a
[0x03] rec0=1e rec1=00 rec2=07 rec3=09e
[0x04] rec0=13 rec1=00 rec2=05 rec3=004
[0x05] rec0=1a rec1=00 rec2=04 rec3=02a
[0x06] rec0=13 rec1=00 rec2=09 rec3=03c
[0x07] rec0=17 rec1=00 rec2=0a rec3=03c
[0x08] rec0=0c rec1=00 rec2=08 rec3=000
[0x09] rec0=0a rec1=00 rec2=08 rec3=000
[0x0a] rec0=5f rec1=bb rec2=80 rec3=000
tail 0x21520432083aa6766a01b 0x42a00088462063c03
Free Block Chain:
0x3: 0000 00 0b 00 17 80 14 73 2e 42 65 68 61 76 69 6f 72 ┆ s.Behavior┆
0xb: 0000 00 00 00 17 80 03 65 72 3b 03 00 00 00 00 0b 20 ┆ er; ┆