|
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 Communication, seg_058367
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io;
with Utils;
with Queue_Generic;
with Byte_Defs;
with Text_Io;
with Utils;
with Text_Io;
with Transport;
with Transport_Defs;
package body Communication is
package T renames Transport;
package T_Defs renames Transport_Defs;
N : constant T_Defs.Network_Name := "TCP/IP";
task Receive_Task is
entry Init (Chanel : in Com_Chanel.Object; Status : out Status_Code);
entry Get_Chanel (Chanel : out Com_Chanel.Object);
entry Get_Message (S : out Var_String.V_String);
entry Message_Waiting (Mw : out Boolean);
entry Dispose;
end Receive_Task;
task body Receive_Task is
package V_String_Fifo is new Queue_Generic
(Element => Var_String.V_String);
Fifo : V_String_Fifo.Queue;
Chanel : Com_Chanel.Object := Com_Chanel.Null_Object;
C : T.Connection_Id;
S : T_Defs.Status_Code;
Socket_Id : T_Defs.Socket_Id (1 .. 2);
M : Var_String.V_String;
D : Byte_Defs.Byte_String (1 .. 1000);
Nb : Natural;
use Com_Chanel;
use Transport_Defs;
begin
accept Init (Chanel : in Com_Chanel.Object; Status : out Status_Code) do
Receive_Task.Chanel := Chanel;
if Chanel = Com_Chanel.Null_Object then
T.Open (Connection => C,
Status => S,
Network => N,
Local_Socket => T_Defs.Null_Socket_Id);
else
T.Open (Connection => C,
Status => S,
Network => N,
Local_Socket => Com_Chanel.Get_Socket_Id (Chanel));
end if;
if (S /= Transport_Defs.Ok) then
Status := Communication.Failed;
Text_Io.Put_Line ("Communication Init error => " &
T_Defs.Image (S));
else
Status := Communication.Ok;
end if;
end Init;
Com_Chanel.Set_Chanel (O => Chanel,
Host => T.Local_Host (Network => N),
Socket => T.Local_Socket (Connection => C));
loop
select
accept Get_Chanel (Chanel : out Com_Chanel.Object) do
Chanel := Receive_Task.Chanel;
end Get_Chanel;
or
accept Get_Message (S : out Var_String.V_String) do
S := V_String_Fifo.First (Q => Fifo);
V_String_Fifo.Delete (Q => Fifo);
end Get_Message;
or
accept Message_Waiting (Mw : out Boolean) do
Mw := not (V_String_Fifo.Is_Empty (Q => Fifo));
end Message_Waiting;
or
delay 2.0;
Text_Io.Put_Line ("try to connect");
T.Connect (Connection => C, Status => S, Max_Wait => 10.0);
if S = Transport_Defs.Ok then
Text_Io.Put_Line ("Connect Ok");
T.Receive (Connection => C,
Status => S,
Data => D,
Count => Nb,
Max_Wait => Duration'Last);
M := Var_String.Value
(Utils.Byte_String_To_String
(D (D'First .. D'First + Nb - 1)));
V_String_Fifo.Add (Q => Fifo, X => M);
Text_Io.Put_Line ("Ajout message a la file d'attente :" &
Var_String.Image (M));
T.Disconnect (Connection => C);
end if;
end select;
end loop;
end Receive_Task;
procedure Send (Message : in Var_String.V_String;
Remote_Host : in Transport_Defs.Host_Id;
Remote_Socket : in Transport_Defs.Socket_Id;
Status : out Status_Code) is
C : T.Connection_Id;
S : T_Defs.Status_Code;
Nb : Natural;
use Transport_Defs;
begin
Status := Communication.Ok;
T.Open (Connection => C,
Status => S,
Network => N,
Local_Socket => T_Defs.Null_Socket_Id);
if (S /= Transport_Defs.Ok) then
Status := Communication.Failed;
Text_Io.Put_Line ("Communication Send Open error => " &
T_Defs.Image (S));
return;
end if;
for I in 1 .. 10 loop
T.Connect (Connection => C,
Status => S,
Remote_Host => Remote_Host,
Remote_Socket => Remote_Socket,
Max_Wait => 10.0);
if (S = Transport_Defs.Ok) then
Text_Io.Put_Line ("Communication Send Connect => Ok");
exit;
else
if I = 10 then
Status := Communication.Failed;
T.Close (Connection => C);
Text_Io.Put_Line ("Communication Send Connect error => " &
T_Defs.Image (S));
return;
else
Text_Io.Put_Line ("Communication Send Connect error => " &
T_Defs.Image (S));
end if;
end if;
delay (5.0);
Text_Io.Put_Line ("Communication Send Connect Next retry");
end loop;
T.Transmit (Connection => C,
Status => S,
Data => Utils.String_To_Byte_String
(Var_String.Image (Message)),
Count => Nb,
Max_Wait => Duration'Last,
More => False);
if (S = Transport_Defs.Ok) then
Text_Io.Put_Line ("Communication Send Transmit => Ok");
else
Status := Communication.Failed;
T.Close (Connection => C);
Text_Io.Put_Line ("Communication Send Transmit error => " &
T_Defs.Image (S));
end if;
T.Close (Connection => C);
end Send;
procedure Receive (Message : out Var_String.V_String;
Status : out Status_Code) is
Mw : Boolean;
begin
Receive_Task.Message_Waiting (Mw);
if Mw = True then
Receive_Task.Get_Message (Message);
Status := Ok;
else
Message := Var_String.Value ("RIEN");
Status := No_Message;
end if;
end Receive;
procedure Init (Chanel : Com_Chanel.Object; Status : out Status_Code) is
begin
Receive_Task.Init (Chanel => Chanel, Status => Status);
end Init;
function Get_Chanel return Com_Chanel.Object is
C : Com_Chanel.Object;
begin
Receive_Task.Get_Chanel (Chanel => C);
return C;
end Get_Chanel;
end Communication;
nblk1=b
nid=b
hdr6=10
[0x00] rec0=25 rec1=00 rec2=01 rec3=016
[0x01] rec0=18 rec1=00 rec2=07 rec3=02a
[0x02] rec0=1a rec1=00 rec2=02 rec3=00c
[0x03] rec0=16 rec1=00 rec2=03 rec3=00e
[0x04] rec0=1a rec1=00 rec2=08 rec3=044
[0x05] rec0=19 rec1=00 rec2=09 rec3=008
[0x06] rec0=1b rec1=00 rec2=0a rec3=00e
[0x07] rec0=14 rec1=00 rec2=06 rec3=000
[0x08] rec0=1a rec1=00 rec2=0a rec3=02c
[0x09] rec0=19 rec1=00 rec2=06 rec3=001
[0x0a] rec0=c8 rec1=03 rec2=a0 rec3=000
tail 0x21765943487e290dc836b 0x42a00088462060003
Free Block Chain:
0xb: 0000 00 05 00 0c 80 09 6e 6e 65 63 74 69 6f 6e 20 09 ┆ nnection ┆
0x5: 0000 00 04 00 32 00 2f 20 20 20 20 70 72 6f 63 65 64 ┆ 2 / proced┆
0x4: 0000 00 00 03 fc 80 0c 6f 20 63 6f 6e 6e 65 63 74 22 ┆ o connect"┆