|
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 - metrics - download
Length: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Message_New, seg_04af5a
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Message_Interchange;
with Parameter;
with Signature;
with String_Utilities;
with Text_Io;
package body Message_New is
Sep : Character renames Message_Interchange.Separator;
function Sup (S : String) return String renames String_Utilities.Upper_Case;
function Create (Class : Message_New.Class;
Addressee : Natural;
Sender : Natural;
Method : Standard.Method.Object;
Request : Natural) return Message_New.Object is
begin
return Object'(Class, Addressee, Sender, Method, Request);
end Create;
function Get_Class
(Message_New : Standard.Message_New.Object) return Class is
begin
return Message_New.Class;
end Get_Class;
function Get_Addressee
(Message_New : Standard.Message_New.Object) return Natural is
begin
return Message_New.Addressee;
end Get_Addressee;
function Get_Sender
(Message_New : Standard.Message_New.Object) return Natural is
begin
return Message_New.Sender;
end Get_Sender;
function Get_Method (Message_New : Standard.Message_New.Object)
return Method.Object is
begin
return Message_New.Method;
end Get_Method;
function Get_Request
(Message_New : Standard.Message_New.Object) return Natural is
begin
return Message_New.Request;
end Get_Request;
function Image (Message_New : Standard.Message_New.Object) return String is
begin
return Class'Image (Message_New.Class) & Sep &
Natural'Image (Message_New.Addressee) & Sep &
Natural'Image (Message_New.Sender) & Sep &
Method.Image (Message_New.Method) & Sep &
Natural'Image (Message_New.Request);
end Image;
function Value (The_String : String) return Message_New.Object is
S : String renames The_String;
Addressee : Positive := The_String'First;
Sender : Positive;
Method : Positive;
Request : Positive;
begin
loop
exit when The_String (Addressee) = Sep;
Addressee := Addressee + 1;
end loop;
Sender := Addressee + 1;
loop
exit when The_String (Sender) = Sep;
Sender := Sender + 1;
end loop;
Method := Sender + 1;
loop
exit when The_String (Method) = Sep;
Method := Method + 1;
end loop;
Request := Method + 1;
loop
exit when The_String (Request) = Sep;
Request := Request + 1;
end loop;
return Object'(Class => Message_New.Class'Value
(S (S'First .. Addressee - 1)),
Addressee => Natural'Value
(S (Addressee + 1 .. Sender - 1)),
Sender => Natural'Value (S (Sender + 1 .. Method - 1)),
Method => Standard.Method.Value
(S (Method + 1 .. Request - 1)),
Request => Natural'Value (S (Request + 1 .. S'Last)));
end Value;
function Create (Class : Message_New.Class;
Addressee : Natural;
Sender : Natural;
Method : String;
Request : Natural;
Parameter_Name : String;
Parameter_Class : String;
Parameter_Value : String) return Message_New.Object is
Sig : Signature.Object := Signature.Create;
Method_1 : Standard.Method.Object;
begin
Signature.Add (To_Signature => Sig,
The_Parameter => Parameter.Create
(Name => Parameter_Name,
Class => Parameter_Class,
Value => Parameter_Value),
At_Position => 1);
Method_1 := Standard.Method.Create (Name => Method, Signature => Sig);
return Object'(Class, Addressee, Sender, Method_1, Request);
end Create;
function Create (Class : Message_New.Class;
Addressee : Natural;
Sender : Natural;
Method : String;
Request : Natural;
Parameter1_Name : String;
Parameter1_Class : String;
Parameter1_Value : String;
Parameter2_Name : String;
Parameter2_Class : String;
Parameter2_Value : String) return Message_New.Object is
Sig : Signature.Object := Signature.Create;
Method_1 : Standard.Method.Object;
begin
Signature.Add (To_Signature => Sig,
The_Parameter => Parameter.Create
(Name => Parameter1_Name,
Class => Parameter1_Class,
Value => Parameter1_Value),
At_Position => 1);
Signature.Add (To_Signature => Sig,
The_Parameter => Parameter.Create
(Name => Parameter2_Name,
Class => Parameter2_Class,
Value => Parameter2_Value),
At_Position => 2);
Method_1 := Standard.Method.Create (Name => Method, Signature => Sig);
return Object'(Class, Addressee, Sender, Method_1, Request);
end Create;
function Create (Class : Message_New.Class;
Addressee : Natural;
Sender : Natural;
Method : String;
Request : Natural;
Parameter1_Name : String;
Parameter1_Class : String;
Parameter1_Value : String;
Parameter2_Name : String;
Parameter2_Class : String;
Parameter2_Value : String;
Parameter3_Name : String;
Parameter3_Class : String;
Parameter3_Value : String) return Message_New.Object is
Sig : Signature.Object := Signature.Create;
Method_1 : Standard.Method.Object;
begin
Signature.Add (To_Signature => Sig,
The_Parameter => Parameter.Create
(Name => Parameter1_Name,
Class => Parameter1_Class,
Value => Parameter1_Value),
At_Position => 1);
Signature.Add (To_Signature => Sig,
The_Parameter => Parameter.Create
(Name => Parameter2_Name,
Class => Parameter2_Class,
Value => Parameter2_Value),
At_Position => 2);
Signature.Add (To_Signature => Sig,
The_Parameter => Parameter.Create
(Name => Parameter3_Name,
Class => Parameter3_Class,
Value => Parameter3_Value),
At_Position => 3);
Method_1 := Standard.Method.Create (Name => Method, Signature => Sig);
return Object'(Class, Addressee, Sender, Method_1, Request);
end Create;
procedure Set_Class (Message_New : in out Standard.Message_New.Object;
Class : Standard.Message_New.Class) is
begin
Message_New.Class := Class;
end Set_Class;
procedure Set_Addressee (Message_New : in out Standard.Message_New.Object;
Addressee : Natural) is
begin
Message_New.Addressee := Addressee;
end Set_Addressee;
procedure Set_Sender (Message_New : in out Standard.Message_New.Object;
Sender : Natural) is
begin
Message_New.Sender := Sender;
end Set_Sender;
procedure Set_Request (Message_New : in out Standard.Message_New.Object;
Request : Natural) is
begin
Message_New.Request := Request;
end Set_Request;
end Message_New;
nblk1=c
nid=c
hdr6=12
[0x00] rec0=22 rec1=00 rec2=01 rec3=028
[0x01] rec0=22 rec1=00 rec2=03 rec3=024
[0x02] rec0=20 rec1=00 rec2=0b rec3=02e
[0x03] rec0=17 rec1=00 rec2=08 rec3=056
[0x04] rec0=17 rec1=00 rec2=06 rec3=020
[0x05] rec0=17 rec1=00 rec2=02 rec3=002
[0x06] rec0=15 rec1=00 rec2=05 rec3=046
[0x07] rec0=12 rec1=00 rec2=0a rec3=050
[0x08] rec0=21 rec1=00 rec2=09 rec3=000
[0x09] rec0=07 rec1=00 rec2=09 rec3=000
[0x0a] rec0=07 rec1=00 rec2=09 rec3=000
[0x0b] rec0=32 rec1=80 rec2=00 rec3=000
tail 0x2174faab2867a4586e5f8 0x42a00088462060003
Free Block Chain:
0xc: 0000 00 04 03 fc 80 07 20 3d 3e 20 33 29 3b 07 00 4f ┆ => 3); O┆
0x4: 0000 00 07 00 3b 80 13 6f 5f 53 69 67 6e 61 74 75 72 ┆ ; o_Signatur┆
0x7: 0000 00 00 00 8c 80 2a 69 67 20 3a 20 53 69 67 6e 61 ┆ *ig : Signa┆