|
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: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Communications, seg_0253a0
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with System;
with Unchecked_Conversion;
with Mac_Types;
with Memory;
with Tcp;
package body Communications is
Receive_Buffer_Size : constant := 16384;
Read_Buffer_Size : constant := Receive_Buffer_Size + 4;
Dtia_Port : constant Tcp.Tcp_Port := 2000;
type Tcp_Driver_State is (Closed, Open);
Tcp_State : Tcp_Driver_State := Closed;
Receive_Buffer : Mac_Types.Ptr := null;
function As_Ptr is new Unchecked_Conversion (Source => System.Address,
Target => Mac_Types.Ptr);
use Mac_Types;
procedure Initialize is
begin
if Tcp_State = Closed then
Receive_Buffer := Memory.Newptr (Read_Buffer_Size);
if Receive_Buffer = null then
raise Memory_Full;
end if;
begin
Tcp.Open_Tcp_Driver;
Tcp_State := Open;
exception
when others =>
raise Open_Tcp_Driver_Failed;
end;
end if;
end Initialize;
use Mac_Types;
procedure Wait_For_Connection (A_Connection : out Connection) is
Recvptr : Mac_Types.Ptr;
Recvlen : Mac_Types.Longint;
Local_Connection : Connection;
begin
if Tcp_State /= Open then
raise Open_Tcp_Driver_Failed;
end if;
Recvptr := Memory.Newptr (Receive_Buffer_Size);
if Recvptr = null then
raise Memory_Full;
end if;
begin
Tcp.Low_Tcp_Create_Stream (Local_Connection.Stream, Recvptr,
Receive_Buffer_Size, null, null);
exception
when others =>
Memory.Disposptr (Recvptr);
raise;
end;
Local_Connection.Stream_Created := True;
Local_Connection.Connection_Opened := False;
Local_Connection.Remote_Host := 0;
Local_Connection.Remote_Port := 0;
Local_Connection.Local_Host := 0;
Local_Connection.Local_Port := Dtia_Port;
Waiting_For_Connection:
loop
declare
Pb : Tcp.Tcpopenpbptr;
begin
Tcp.Low_Tcp_Wait_For_Connection
(Local_Connection.Stream, 10,
Local_Connection.Remote_Host,
Local_Connection.Remote_Port,
Local_Connection.Local_Host,
Local_Connection.Local_Port, False, null, Pb);
Local_Connection.Connection_Opened := True;
exit Waiting_For_Connection;
exception
when Tcp.Timeout_Error =>
null; -- Try again
when others =>
Local_Connection.Stream_Created := False;
Tcp.Low_Tcp_Release
(Local_Connection.Stream, Recvptr, Recvlen);
Memory.Disposptr (Recvptr);
raise;
end;
end loop Waiting_For_Connection;
A_Connection := Local_Connection;
end Wait_For_Connection;
procedure Close_Connection (A_Connection : in out Connection) is
Recvptr : Mac_Types.Ptr;
Recvlen : Mac_Types.Longint;
begin
if Tcp_State /= Open then
raise Open_Tcp_Driver_Failed;
end if;
if A_Connection.Connection_Opened then
Tcp.Low_Tcp_Close (A_Connection.Stream, 2);
Tcp.Low_Tcp_Abort (A_Connection.Stream);
A_Connection.Connection_Opened := False;
end if;
if A_Connection.Stream_Created then
Tcp.Low_Tcp_Release (A_Connection.Stream, Recvptr, Recvlen);
Memory.Disposptr (Recvptr);
A_Connection.Stream_Created := False;
end if;
end Close_Connection;
procedure Write (A_Connection : in out Connection; Data : in Bytearray) is
type Wds_Array is array (0 .. 1) of Tcp.Wdsentry;
Mywds : Wds_Array;
Pb : Tcp.Tcpsendpbptr;
begin
if Tcp_State /= Open then
raise Open_Tcp_Driver_Failed;
end if;
if A_Connection.Stream_Created and A_Connection.Connection_Opened then
Mywds (0).Length := Data'Length;
Mywds (0).Ptr := As_Ptr (Data (Data'First)'Address);
Mywds (1).Length := 0;
Mywds (1).Ptr := null;
Tcp.Low_Tcp_Send_Data
(A_Connection.Stream, 10, True, False,
As_Ptr (Mywds (Mywds'First)'Address), False, null, Pb);
else
raise Connection_Doesnt_Exist;
end if;
end Write;
procedure Read (A_Connection : in out Connection; Data : out Bytearray) is
Urgent : Boolean;
Mark : Boolean;
Remaining : Natural;
Index : Natural;
Rcvlen : Tcp.B_16;
Pb : Tcp.Tcpreceivepbptr;
begin
if Tcp_State /= Open then
raise Open_Tcp_Driver_Failed;
end if;
if A_Connection.Stream_Created and A_Connection.Connection_Opened then
Remaining := Data'Length;
Index := 0;
while Remaining > 0 loop
Rcvlen := Tcp.B_16 (Remaining);
begin
Tcp.Low_Tcp_Recv_Data (A_Connection.Stream, 10,
Urgent, Mark, Receive_Buffer,
Rcvlen, False, null, Pb);
Memory.Blockmove
(Srcptr => Receive_Buffer,
Destptr => As_Ptr (Data (Data'First + Index)'Address),
Bytecount => Memory.Size (Rcvlen));
Index := Index + Natural (Rcvlen);
Remaining := Remaining - Natural (Rcvlen);
exception
when Tcp.Timeout_Error =>
null; -- try again
when others =>
raise;
end;
end loop;
else
raise Connection_Doesnt_Exist;
end if;
end Read;
end Communications;
nblk1=8
nid=0
hdr6=10
[0x00] rec0=24 rec1=00 rec2=01 rec3=038
[0x01] rec0=23 rec1=00 rec2=03 rec3=01c
[0x02] rec0=16 rec1=00 rec2=08 rec3=082
[0x03] rec0=0d rec1=00 rec2=07 rec3=01e
[0x04] rec0=1f rec1=00 rec2=06 rec3=02a
[0x05] rec0=1c rec1=00 rec2=04 rec3=014
[0x06] rec0=16 rec1=00 rec2=02 rec3=01e
[0x07] rec0=04 rec1=00 rec2=05 rec3=000
tail 0x217202e7683a240401ebb 0x42a00088462060003