|
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: 22528 (0x5800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package body My_Message, seg_055c8b, seg_055c92
└─⟦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 Byte_Defs;
with Bounded_String;
with Const_Orb;
with Io_Exceptions;
with Transport;
with Transport_Defs;
with Utils;
package body My_Message is
function Initialize (Op : Kind_Of_Message;
Cont : My_String;
Req_I : Positive := Positive'Last;
L_I : My_String;
R_I : My_String) return Object is
begin
case Op is
when Request =>
return Object'(Operation => Request,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I,
Remote_Identifier => R_I);
when Reply =>
return Object'(Operation => Reply,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I,
Remote_Identifier => R_I);
when Reply_Filtration =>
return Object'(Operation => Reply_Filtration,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I,
Remote_Identifier => R_I);
when Forward =>
return Object'(Operation => Forward,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I,
Remote_Identifier => R_I);
when others =>
null;
end case;
end Initialize;
function Initialize (Op : Kind_Of_Message;
Cont : My_String;
Req_I : Positive := Positive'Last;
L_I : My_String) return Object is
R_I : My_String;
begin
case Op is
when Registration =>
return Object'(Operation => Registration,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Unregistration =>
return Object'(Operation => Unregistration,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Request =>
Bounded_String.Copy (R_I, Const_Orb.No_Remote_Id);
return Object'(Operation => Request,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I,
Remote_Identifier => R_I);
when Forward =>
return Object'(Operation => Forward,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I,
Remote_Identifier => R_I);
when Forward_Filtration =>
return Object'(Operation => Forward_Filtration,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Forward_Reply =>
return Object'(Operation => Forward_Reply,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Publication =>
return Object'(Operation => Publication,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Unpublication =>
return Object'(Operation => Unpublication,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Publication_Filter =>
return Object'(Operation => Publication_Filter,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Unpublication_Filter =>
return Object'(Operation => Unpublication_Filter,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Subscription =>
return Object'(Operation => Subscription,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Unsubscription =>
return Object'(Operation => Unsubscription,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Filtration =>
return Object'(Operation => Filtration,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Unfiltration =>
return Object'(Operation => Unfiltration,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Reply_Error =>
return Object'(Operation => Reply_Error,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Reply_Filtration =>
return Object'(Operation => Reply_Filtration,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I,
Remote_Identifier => R_I);
when Reply_Subscription =>
return Object'(Operation => Reply_Subscription,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Content =>
return Object'(Operation => Content,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Notification =>
return Object'(Operation => Notification,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when Query =>
return Object'(Operation => Query,
Content => Cont,
Request_Identifier => Req_I,
Local_Identifier => L_I);
when others =>
null;
end case;
end Initialize;
generic
Char : Character;
procedure Extract (Target : in out My_String;
Source : My_String;
Crt : in out Positive);
procedure Extract (Target : in out My_String;
Source : My_String;
Crt : in out Positive) is
begin
while Bounded_String.Char_At (Source, Crt) /= Char loop
Bounded_String.Append (Target,
Bounded_String.Char_At (Source, Crt));
Crt := Crt + 1;
end loop;
Crt := Crt + 1;
end Extract;
function Image (Mess : Object) return My_String is
Buffer : My_String;
Separator : constant Character := '#';
begin
Bounded_String.Copy
(Buffer, Separator & Kind_Of_Message'Image (Mess.Operation) &
Separator & Bounded_String.Image (Mess.Content) &
Separator &
Bounded_String.Image (Mess.Local_Identifier) &
Separator);
if Mess.Operation = Request or Mess.Operation = Forward or
Mess.Operation = Reply or Mess.Operation = Reply_Filtration then
Bounded_String.Append
(Buffer, Bounded_String.Image (Mess.Remote_Identifier) &
Separator);
end if;
Bounded_String.Append
(Buffer, Positive'Image (Mess.Request_Identifier) & Separator);
return Buffer;
end Image;
function Value (Mess : My_String) return Object is
Separator : constant Character := '#';
Crt, Last : Positive;
Op : Kind_Of_Message;
Buffer : My_String;
Cont_Tmp, L_Id_Tmp, R_Id_Tmp, Req_Id_Tmp : My_String;
procedure Extract_Value is new Extract (Char => Separator);
begin
Crt := 1;
if Bounded_String.Char_At (Mess, Crt) = Separator then
Crt := Crt + 1;
else
Text_Io.Put_Line ("First separator is missing");
end if;
Extract_Value (Target => Buffer, Source => Mess, Crt => Crt);
Kind_Of_Mess_Io.Get (Bounded_String.Image (Buffer), Op,
Last); -- Transforme un string en enumeration
Extract_Value (Target => Cont_Tmp, Source => Mess, Crt => Crt);
Extract_Value (Target => L_Id_Tmp, Source => Mess, Crt => Crt);
if Op = Request or Op = Reply or
Op = Forward or Op = Reply_Filtration then
Extract_Value (Target => R_Id_Tmp, Source => Mess, Crt => Crt);
Extract_Value (Target => Req_Id_Tmp, Source => Mess, Crt => Crt);
return Initialize (Op => Op,
Cont => Cont_Tmp,
Req_I => Positive'Value
(Bounded_String.Image (Req_Id_Tmp)),
L_I => L_Id_Tmp,
R_I => R_Id_Tmp);
else
Extract_Value (Target => Req_Id_Tmp, Source => Mess, Crt => Crt);
return Initialize (Op => Op,
Cont => Cont_Tmp,
Req_I => Positive'Value
(Bounded_String.Image (Req_Id_Tmp)),
L_I => L_Id_Tmp);
end if;
end Value;
function Get_Operation (Mess : Object) return Kind_Of_Message is
begin
return Mess.Operation;
end Get_Operation;
function Get_Content (Mess : Object) return My_String is
begin
return Mess.Content;
end Get_Content;
function Get_Request_Identifier (Mess : Object) return Positive is
begin
return Mess.Request_Identifier;
end Get_Request_Identifier;
function Get_Local_Identifier (Mess : Object) return My_String is
begin
return Mess.Local_Identifier;
end Get_Local_Identifier;
function Get_Remote_Identifier (Mess : Object) return My_String is
begin
return Mess.Remote_Identifier;
end Get_Remote_Identifier;
procedure Send (Mess : in out Object; Rem_Id : My_String) is
Connection : Transport.Connection_Id;
Status : Transport_Defs.Status_Code;
Local_Socket, Remote_Socket : Transport_Defs.Socket_Id (0 .. 1);
Local_Host, Remote_Host, Host_Tmp : Const_Orb.Host;
Separator : constant Character := '%';
Crt, Last : Positive;
Count : Natural;
L_H : String (1 .. 15);
Buffer, R_Id_Tmp, R_H_Tmp : My_String;
procedure Extract_Send is new Extract (Char => Separator);
package Host_Io is new Text_Io.Enumeration_Io (Const_Orb.Host);
begin
while not Transport.Is_Open (Connection) loop
Transport.Open (Connection => Connection,
Status => Status,
Network => Const_Orb.Our_Network);
end loop;
if Get_Operation (Mess) = Registration then
loop
begin
Text_Io.Put ("Type your machine's name: ");
Host_Io.Get (Host_Tmp);
exit;
exception
when Io_Exceptions.Data_Error =>
Text_Io.Put_Line (" Bad argument !");
Text_Io.Put ("You must type one of these names: ");
for I in Const_Orb.Host loop
Host_Io.Put (I);
Text_Io.Put (", ");
end loop;
Text_Io.Put_Line ("");
end;
end loop;
Host_Io.Put (L_H, Host_Tmp);
Text_Io.New_Line;
Bounded_String.Copy (Mess.Local_Identifier,
Utils.Byte_String_To_String
(Byte_Defs.Byte_String
(Transport.Local_Socket (Connection))) &
Separator & L_H & Separator);
Text_Io.Put_Line ("Waiting for the connection with ORB...");
end if;
Crt := Positive'First;
Extract_Send (Target => R_Id_Tmp, Source => Rem_Id, Crt => Crt);
Remote_Socket := Transport_Defs.Socket_Id
(Utils.String_To_Byte_String
(Bounded_String.Image (R_Id_Tmp)));
Extract_Send (Target => R_H_Tmp, Source => Rem_Id, Crt => Crt);
Const_Orb.Host_Io.Get (From => Bounded_String.Image (R_H_Tmp),
Item => Remote_Host,
Last => Last);
while not Transport.Is_Connected (Connection) loop
Transport.Connect
(Connection, Status,
Const_Orb.Our_Host_Table (Remote_Host), Remote_Socket);
end loop;
Transport.Transmit
(Connection, Status,
Utils.String_To_Byte_String (Bounded_String.Image (Image (Mess))),
Count);
Text_Io.Put_Line (Natural'Image (Count) &
" bytes have been transmitted. Message : " &
Bounded_String.Image (Image (Mess)));
Transport.Disconnect (Connection);
Transport.Close (Connection);
end Send;
procedure Receive (Mess : out Object; Local_Id : My_String) is
Connection : Transport.Connection_Id;
Status : Transport_Defs.Status_Code;
Local_Socket : Transport_Defs.Socket_Id (0 .. 1);
Data : Byte_Defs.Byte_String (1 .. 255);
Count : Natural;
Separator : constant Character := '%';
L_Id_Tmp : My_String;
Crt : Positive;
procedure Extract_Receive is new Extract (Char => Separator);
begin
Crt := Positive'First;
Extract_Receive (Target => L_Id_Tmp, Source => Local_Id, Crt => Crt);
Local_Socket := Transport_Defs.Socket_Id
(Utils.String_To_Byte_String
(Bounded_String.Image (L_Id_Tmp)));
while not Transport.Is_Open (Connection) loop
Transport.Open (Connection, Status,
Const_Orb.Our_Network, Local_Socket);
end loop;
Transport.Connect (Connection, Status);
Transport.Receive (Connection, Status, Data, Count);
Mess := Value (Bounded_String.Value
(Utils.Byte_String_To_String (Data)));
Transport.Disconnect (Connection);
Transport.Close (Connection);
end Receive;
end My_Message;
nblk1=15
nid=a
hdr6=24
[0x00] rec0=1d rec1=00 rec2=01 rec3=046
[0x01] rec0=17 rec1=00 rec2=14 rec3=03a
[0x02] rec0=14 rec1=00 rec2=04 rec3=072
[0x03] rec0=14 rec1=00 rec2=0e rec3=01a
[0x04] rec0=05 rec1=00 rec2=03 rec3=02a
[0x05] rec0=12 rec1=00 rec2=05 rec3=068
[0x06] rec0=0b rec1=00 rec2=0f rec3=02c
[0x07] rec0=12 rec1=00 rec2=07 rec3=068
[0x08] rec0=19 rec1=00 rec2=10 rec3=04e
[0x09] rec0=1a rec1=00 rec2=02 rec3=046
[0x0a] rec0=19 rec1=00 rec2=08 rec3=02a
[0x0b] rec0=10 rec1=00 rec2=11 rec3=080
[0x0c] rec0=1f rec1=00 rec2=0d rec3=008
[0x0d] rec0=18 rec1=00 rec2=0c rec3=03e
[0x0e] rec0=16 rec1=00 rec2=15 rec3=056
[0x0f] rec0=12 rec1=00 rec2=13 rec3=02c
[0x10] rec0=1a rec1=00 rec2=0b rec3=02c
[0x11] rec0=19 rec1=00 rec2=06 rec3=000
[0x12] rec0=19 rec1=00 rec2=0b rec3=054
[0x13] rec0=05 rec1=00 rec2=06 rec3=000
[0x14] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21760f06a87c05ce0ce1c 0x42a00088462060003
Free Block Chain:
0xa: 0000 00 09 03 fc 00 39 20 20 20 20 20 20 20 20 20 20 ┆ 9 ┆
0x9: 0000 00 12 00 17 80 14 6c 5f 49 64 65 6e 74 69 66 69 ┆ l_Identifi┆
0x12: 0000 00 00 00 09 80 06 74 65 6d 20 3d 3e 06 73 20 3a ┆ tem => s :┆